{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Model-based tests for the immutable DB.
--
-- This is the main test for the immutable DB. As in any model based, we have a
-- set of commands, which in this case corresponds to things like:
--
-- * Read a block, or information about a block, from the DB
-- * Append a block to the database
-- * Stream blocks from the DB
--
-- See 'Cmd' for the full list of commands.
--
-- In addition, there are commands that model disk corruption, so that we can
-- test that the DB does the right thing in the presence of disk failure. The
-- consensus storage layer has a simple policy for disk corruption: /it is
-- always sound to truncate the chain/; after all, we can always get the
-- remaining blocks from other peers again. This means that in the models, disk
-- corruption is simply modelled as truncation of the chain; the real thing of
-- course needs to be able /detect/ the corruption, minimize quite how far we
-- truncate, etc.
--
-- The model (defined in 'Test.Ouroboros.Storage.ImmutableDB.Model') is
-- essentially just a mapping from slots to blocks. It needs to maintain a /bit/
-- more state than that, in order to deal with stateful API components such as
-- database cursors, but that's basically it.
--
module Test.Ouroboros.Storage.ImmutableDB.StateMachine (
    showLabelledExamples
  , tests
  ) where

import           Control.Concurrent.Class.MonadSTM.Strict (newTMVar)
import           Control.Monad (forM_, void)
import           Control.ResourceRegistry
import           Data.Bifunctor (first)
import           Data.ByteString.Lazy (ByteString)
import           Data.Coerce (Coercible, coerce)
import           Data.Foldable (toList)
import           Data.Function (on)
import           Data.Functor.Classes (Eq1, Show1)
import           Data.Functor.Identity (Identity)
import           Data.List (delete, partition, sortBy)
import qualified Data.List.NonEmpty as NE
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (isJust, listToMaybe)
import           Data.TreeDiff (ToExpr (..))
import           Data.Typeable (Typeable)
import           Data.Word (Word16, Word64)
import qualified Generics.SOP as SOP
import           GHC.Generics (Generic, Generic1)
import           GHC.Stack (HasCallStack)
import           NoThunks.Class (AllowThunk (..))
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Storage.Common
import           Ouroboros.Consensus.Storage.ImmutableDB hiding (streamAll)
import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal
                     (unsafeChunkNoToEpochNo)
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index as Index
                     (CacheConfig (..))
import           Ouroboros.Consensus.Storage.ImmutableDB.Impl.Util
import           Ouroboros.Consensus.Util.IOLike
import           Prelude hiding (elem, notElem)
import           System.FS.API (HasFS (..), SomeHasFS (..))
import           System.FS.API.Types (FsPath, mkFsPath)
import           System.FS.Sim.Error (Errors, emptyErrors, simErrorHasFS,
                     withErrors)
import qualified System.FS.Sim.MockFS as Mock
import           System.Random (getStdRandom, randomR)
import           Test.Ouroboros.Storage.ImmutableDB.Model
import           Test.Ouroboros.Storage.Orphans ()
import           Test.Ouroboros.Storage.TestBlock
import           Test.QuickCheck hiding (forAll)
import qualified Test.QuickCheck.Monadic as QC
import           Test.QuickCheck.Random (mkQCGen)
import           Test.StateMachine hiding (showLabelledExamples,
                     showLabelledExamples')
import qualified Test.StateMachine.Labelling as C
import qualified Test.StateMachine.Sequential as QSM
import qualified Test.StateMachine.Types as QSM
import qualified Test.StateMachine.Types.Rank2 as Rank2
import           Test.Tasty (TestTree, testGroup)
import           Test.Tasty.QuickCheck (testProperty)
import           Test.Util.ChunkInfo
import           Test.Util.Orphans.Arbitrary ()
import           Test.Util.Orphans.ToExpr ()
import           Test.Util.QuickCheck (collects)
import qualified Test.Util.RefEnv as RE
import           Test.Util.RefEnv (RefEnv)
import           Test.Util.SOP
import           Test.Util.ToExpr ()
import           Test.Util.Tracer (recordingTracerIORef)
import           Test.Util.WithEq
import           Text.Show.Pretty (ppShow)

{-------------------------------------------------------------------------------
  Abstract model
-------------------------------------------------------------------------------}

-- | Commands
--
-- 'Cmd' will be instantiated to:
--
-- > Cmd (IterRef m r)
-- > Cmd (Iterator m)
--
-- Where @m@ can be 'PureM', 'RealM', or 'RealErrM', and @r@ can be 'Symbolic'
-- or 'Concrete'.
data Cmd it =
    GetTip
  | GetBlockComponent      (RealPoint TestBlock)
  | AppendBlock            TestBlock
  | Stream                 (StreamFrom TestBlock) (StreamTo TestBlock)
  | StreamAll
  | IteratorNext           it
  | IteratorHasNext        it
  | IteratorClose          it
  | Reopen                 ValidationPolicy
  | Migrate                ValidationPolicy
  | DeleteAfter            (WithOrigin (Tip TestBlock))
  | GetHashForSlot         SlotNo
  | Corruption             Corruption
  deriving ((forall x. Cmd it -> Rep (Cmd it) x)
-> (forall x. Rep (Cmd it) x -> Cmd it) -> Generic (Cmd it)
forall x. Rep (Cmd it) x -> Cmd it
forall x. Cmd it -> Rep (Cmd it) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall it x. Rep (Cmd it) x -> Cmd it
forall it x. Cmd it -> Rep (Cmd it) x
$cfrom :: forall it x. Cmd it -> Rep (Cmd it) x
from :: forall x. Cmd it -> Rep (Cmd it) x
$cto :: forall it x. Rep (Cmd it) x -> Cmd it
to :: forall x. Rep (Cmd it) x -> Cmd it
Generic, Int -> Cmd it -> ShowS
[Cmd it] -> ShowS
Cmd it -> String
(Int -> Cmd it -> ShowS)
-> (Cmd it -> String) -> ([Cmd it] -> ShowS) -> Show (Cmd it)
forall it. Show it => Int -> Cmd it -> ShowS
forall it. Show it => [Cmd it] -> ShowS
forall it. Show it => Cmd it -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall it. Show it => Int -> Cmd it -> ShowS
showsPrec :: Int -> Cmd it -> ShowS
$cshow :: forall it. Show it => Cmd it -> String
show :: Cmd it -> String
$cshowList :: forall it. Show it => [Cmd it] -> ShowS
showList :: [Cmd it] -> ShowS
Show, (forall a b. (a -> b) -> Cmd a -> Cmd b)
-> (forall a b. a -> Cmd b -> Cmd a) -> Functor Cmd
forall a b. a -> Cmd b -> Cmd a
forall a b. (a -> b) -> Cmd a -> Cmd b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Cmd a -> Cmd b
fmap :: forall a b. (a -> b) -> Cmd a -> Cmd b
$c<$ :: forall a b. a -> Cmd b -> Cmd a
<$ :: forall a b. a -> Cmd b -> Cmd a
Functor, (forall m. Monoid m => Cmd m -> m)
-> (forall m a. Monoid m => (a -> m) -> Cmd a -> m)
-> (forall m a. Monoid m => (a -> m) -> Cmd a -> m)
-> (forall a b. (a -> b -> b) -> b -> Cmd a -> b)
-> (forall a b. (a -> b -> b) -> b -> Cmd a -> b)
-> (forall b a. (b -> a -> b) -> b -> Cmd a -> b)
-> (forall b a. (b -> a -> b) -> b -> Cmd a -> b)
-> (forall a. (a -> a -> a) -> Cmd a -> a)
-> (forall a. (a -> a -> a) -> Cmd a -> a)
-> (forall a. Cmd a -> [a])
-> (forall a. Cmd a -> Bool)
-> (forall a. Cmd a -> Int)
-> (forall a. Eq a => a -> Cmd a -> Bool)
-> (forall a. Ord a => Cmd a -> a)
-> (forall a. Ord a => Cmd a -> a)
-> (forall a. Num a => Cmd a -> a)
-> (forall a. Num a => Cmd a -> a)
-> Foldable Cmd
forall a. Eq a => a -> Cmd a -> Bool
forall a. Num a => Cmd a -> a
forall a. Ord a => Cmd a -> a
forall m. Monoid m => Cmd m -> m
forall a. Cmd a -> Bool
forall a. Cmd a -> Int
forall a. Cmd a -> [a]
forall a. (a -> a -> a) -> Cmd a -> a
forall m a. Monoid m => (a -> m) -> Cmd a -> m
forall b a. (b -> a -> b) -> b -> Cmd a -> b
forall a b. (a -> b -> b) -> b -> Cmd a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Cmd m -> m
fold :: forall m. Monoid m => Cmd m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Cmd a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Cmd a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Cmd a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Cmd a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Cmd a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Cmd a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Cmd a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Cmd a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Cmd a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Cmd a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Cmd a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Cmd a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Cmd a -> a
foldr1 :: forall a. (a -> a -> a) -> Cmd a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Cmd a -> a
foldl1 :: forall a. (a -> a -> a) -> Cmd a -> a
$ctoList :: forall a. Cmd a -> [a]
toList :: forall a. Cmd a -> [a]
$cnull :: forall a. Cmd a -> Bool
null :: forall a. Cmd a -> Bool
$clength :: forall a. Cmd a -> Int
length :: forall a. Cmd a -> Int
$celem :: forall a. Eq a => a -> Cmd a -> Bool
elem :: forall a. Eq a => a -> Cmd a -> Bool
$cmaximum :: forall a. Ord a => Cmd a -> a
maximum :: forall a. Ord a => Cmd a -> a
$cminimum :: forall a. Ord a => Cmd a -> a
minimum :: forall a. Ord a => Cmd a -> a
$csum :: forall a. Num a => Cmd a -> a
sum :: forall a. Num a => Cmd a -> a
$cproduct :: forall a. Num a => Cmd a -> a
product :: forall a. Num a => Cmd a -> a
Foldable, Functor Cmd
Foldable Cmd
(Functor Cmd, Foldable Cmd) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Cmd a -> f (Cmd b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Cmd (f a) -> f (Cmd a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Cmd a -> m (Cmd b))
-> (forall (m :: * -> *) a. Monad m => Cmd (m a) -> m (Cmd a))
-> Traversable Cmd
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Cmd (m a) -> m (Cmd a)
forall (f :: * -> *) a. Applicative f => Cmd (f a) -> f (Cmd a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cmd a -> m (Cmd b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cmd a -> f (Cmd b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cmd a -> f (Cmd b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Cmd a -> f (Cmd b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Cmd (f a) -> f (Cmd a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Cmd (f a) -> f (Cmd a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cmd a -> m (Cmd b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Cmd a -> m (Cmd b)
$csequence :: forall (m :: * -> *) a. Monad m => Cmd (m a) -> m (Cmd a)
sequence :: forall (m :: * -> *) a. Monad m => Cmd (m a) -> m (Cmd a)
Traversable)

deriving instance SOP.Generic         (Cmd it)
deriving instance SOP.HasDatatypeInfo (Cmd it)

-- | Simulate corruption of some files of the database.
newtype Corruption = MkCorruption { Corruption -> Corruptions
getCorruptions :: Corruptions }
  deriving ((forall x. Corruption -> Rep Corruption x)
-> (forall x. Rep Corruption x -> Corruption) -> Generic Corruption
forall x. Rep Corruption x -> Corruption
forall x. Corruption -> Rep Corruption x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Corruption -> Rep Corruption x
from :: forall x. Corruption -> Rep Corruption x
$cto :: forall x. Rep Corruption x -> Corruption
to :: forall x. Rep Corruption x -> Corruption
Generic, Int -> Corruption -> ShowS
[Corruption] -> ShowS
Corruption -> String
(Int -> Corruption -> ShowS)
-> (Corruption -> String)
-> ([Corruption] -> ShowS)
-> Show Corruption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Corruption -> ShowS
showsPrec :: Int -> Corruption -> ShowS
$cshow :: Corruption -> String
show :: Corruption -> String
$cshowList :: [Corruption] -> ShowS
showList :: [Corruption] -> ShowS
Show)

-- | A 'Cmd' together with 'Errors'.
--
-- When executing the 'Cmd', these 'Errors' are passed to 'SimErrorFS' to
-- simulate file system errors thrown at the 'HasFS' level. When 'Nothing', no
-- errors will be thrown.
data CmdErr it = CmdErr {
      forall it. CmdErr it -> Maybe Errors
cmdErr :: Maybe Errors
    , forall it. CmdErr it -> Cmd it
cmd    :: Cmd it
    }
  deriving (Int -> CmdErr it -> ShowS
[CmdErr it] -> ShowS
CmdErr it -> String
(Int -> CmdErr it -> ShowS)
-> (CmdErr it -> String)
-> ([CmdErr it] -> ShowS)
-> Show (CmdErr it)
forall it. Show it => Int -> CmdErr it -> ShowS
forall it. Show it => [CmdErr it] -> ShowS
forall it. Show it => CmdErr it -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall it. Show it => Int -> CmdErr it -> ShowS
showsPrec :: Int -> CmdErr it -> ShowS
$cshow :: forall it. Show it => CmdErr it -> String
show :: CmdErr it -> String
$cshowList :: forall it. Show it => [CmdErr it] -> ShowS
showList :: [CmdErr it] -> ShowS
Show, (forall x. CmdErr it -> Rep (CmdErr it) x)
-> (forall x. Rep (CmdErr it) x -> CmdErr it)
-> Generic (CmdErr it)
forall x. Rep (CmdErr it) x -> CmdErr it
forall x. CmdErr it -> Rep (CmdErr it) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall it x. Rep (CmdErr it) x -> CmdErr it
forall it x. CmdErr it -> Rep (CmdErr it) x
$cfrom :: forall it x. CmdErr it -> Rep (CmdErr it) x
from :: forall x. CmdErr it -> Rep (CmdErr it) x
$cto :: forall it x. Rep (CmdErr it) x -> CmdErr it
to :: forall x. Rep (CmdErr it) x -> CmdErr it
Generic, (forall a b. (a -> b) -> CmdErr a -> CmdErr b)
-> (forall a b. a -> CmdErr b -> CmdErr a) -> Functor CmdErr
forall a b. a -> CmdErr b -> CmdErr a
forall a b. (a -> b) -> CmdErr a -> CmdErr b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> CmdErr a -> CmdErr b
fmap :: forall a b. (a -> b) -> CmdErr a -> CmdErr b
$c<$ :: forall a b. a -> CmdErr b -> CmdErr a
<$ :: forall a b. a -> CmdErr b -> CmdErr a
Functor, (forall m. Monoid m => CmdErr m -> m)
-> (forall m a. Monoid m => (a -> m) -> CmdErr a -> m)
-> (forall m a. Monoid m => (a -> m) -> CmdErr a -> m)
-> (forall a b. (a -> b -> b) -> b -> CmdErr a -> b)
-> (forall a b. (a -> b -> b) -> b -> CmdErr a -> b)
-> (forall b a. (b -> a -> b) -> b -> CmdErr a -> b)
-> (forall b a. (b -> a -> b) -> b -> CmdErr a -> b)
-> (forall a. (a -> a -> a) -> CmdErr a -> a)
-> (forall a. (a -> a -> a) -> CmdErr a -> a)
-> (forall a. CmdErr a -> [a])
-> (forall a. CmdErr a -> Bool)
-> (forall a. CmdErr a -> Int)
-> (forall a. Eq a => a -> CmdErr a -> Bool)
-> (forall a. Ord a => CmdErr a -> a)
-> (forall a. Ord a => CmdErr a -> a)
-> (forall a. Num a => CmdErr a -> a)
-> (forall a. Num a => CmdErr a -> a)
-> Foldable CmdErr
forall a. Eq a => a -> CmdErr a -> Bool
forall a. Num a => CmdErr a -> a
forall a. Ord a => CmdErr a -> a
forall m. Monoid m => CmdErr m -> m
forall a. CmdErr a -> Bool
forall a. CmdErr a -> Int
forall a. CmdErr a -> [a]
forall a. (a -> a -> a) -> CmdErr a -> a
forall m a. Monoid m => (a -> m) -> CmdErr a -> m
forall b a. (b -> a -> b) -> b -> CmdErr a -> b
forall a b. (a -> b -> b) -> b -> CmdErr a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => CmdErr m -> m
fold :: forall m. Monoid m => CmdErr m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CmdErr a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> CmdErr a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CmdErr a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> CmdErr a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> CmdErr a -> b
foldr :: forall a b. (a -> b -> b) -> b -> CmdErr a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CmdErr a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> CmdErr a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CmdErr a -> b
foldl :: forall b a. (b -> a -> b) -> b -> CmdErr a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CmdErr a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> CmdErr a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> CmdErr a -> a
foldr1 :: forall a. (a -> a -> a) -> CmdErr a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CmdErr a -> a
foldl1 :: forall a. (a -> a -> a) -> CmdErr a -> a
$ctoList :: forall a. CmdErr a -> [a]
toList :: forall a. CmdErr a -> [a]
$cnull :: forall a. CmdErr a -> Bool
null :: forall a. CmdErr a -> Bool
$clength :: forall a. CmdErr a -> Int
length :: forall a. CmdErr a -> Int
$celem :: forall a. Eq a => a -> CmdErr a -> Bool
elem :: forall a. Eq a => a -> CmdErr a -> Bool
$cmaximum :: forall a. Ord a => CmdErr a -> a
maximum :: forall a. Ord a => CmdErr a -> a
$cminimum :: forall a. Ord a => CmdErr a -> a
minimum :: forall a. Ord a => CmdErr a -> a
$csum :: forall a. Num a => CmdErr a -> a
sum :: forall a. Num a => CmdErr a -> a
$cproduct :: forall a. Num a => CmdErr a -> a
product :: forall a. Num a => CmdErr a -> a
Foldable, Functor CmdErr
Foldable CmdErr
(Functor CmdErr, Foldable CmdErr) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> CmdErr a -> f (CmdErr b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    CmdErr (f a) -> f (CmdErr a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> CmdErr a -> m (CmdErr b))
-> (forall (m :: * -> *) a.
    Monad m =>
    CmdErr (m a) -> m (CmdErr a))
-> Traversable CmdErr
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => CmdErr (m a) -> m (CmdErr a)
forall (f :: * -> *) a.
Applicative f =>
CmdErr (f a) -> f (CmdErr a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CmdErr a -> m (CmdErr b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CmdErr a -> f (CmdErr b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CmdErr a -> f (CmdErr b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CmdErr a -> f (CmdErr b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CmdErr (f a) -> f (CmdErr a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
CmdErr (f a) -> f (CmdErr a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CmdErr a -> m (CmdErr b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CmdErr a -> m (CmdErr b)
$csequence :: forall (m :: * -> *) a. Monad m => CmdErr (m a) -> m (CmdErr a)
sequence :: forall (m :: * -> *) a. Monad m => CmdErr (m a) -> m (CmdErr a)
Traversable)

-- | Return type for successful database operations.
data Success it =
    Unit            ()
  | ErAllComponents (Either (MissingBlock TestBlock) (AllComponents TestBlock))
  | Iter            (Either (MissingBlock TestBlock) it)
  | IterResult      (IteratorResult (AllComponents TestBlock))
  | IterHasNext     (Maybe (RealPoint TestBlock))
  | IterResults     [AllComponents TestBlock]
  | ImmTip          (WithOrigin (Tip TestBlock))
  | HashForSlot     (Maybe TestHeaderHash)
  deriving (Success it -> Success it -> Bool
(Success it -> Success it -> Bool)
-> (Success it -> Success it -> Bool) -> Eq (Success it)
forall it. Eq it => Success it -> Success it -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall it. Eq it => Success it -> Success it -> Bool
== :: Success it -> Success it -> Bool
$c/= :: forall it. Eq it => Success it -> Success it -> Bool
/= :: Success it -> Success it -> Bool
Eq, Int -> Success it -> ShowS
[Success it] -> ShowS
Success it -> String
(Int -> Success it -> ShowS)
-> (Success it -> String)
-> ([Success it] -> ShowS)
-> Show (Success it)
forall it. Show it => Int -> Success it -> ShowS
forall it. Show it => [Success it] -> ShowS
forall it. Show it => Success it -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall it. Show it => Int -> Success it -> ShowS
showsPrec :: Int -> Success it -> ShowS
$cshow :: forall it. Show it => Success it -> String
show :: Success it -> String
$cshowList :: forall it. Show it => [Success it] -> ShowS
showList :: [Success it] -> ShowS
Show, (forall a b. (a -> b) -> Success a -> Success b)
-> (forall a b. a -> Success b -> Success a) -> Functor Success
forall a b. a -> Success b -> Success a
forall a b. (a -> b) -> Success a -> Success b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Success a -> Success b
fmap :: forall a b. (a -> b) -> Success a -> Success b
$c<$ :: forall a b. a -> Success b -> Success a
<$ :: forall a b. a -> Success b -> Success a
Functor, (forall m. Monoid m => Success m -> m)
-> (forall m a. Monoid m => (a -> m) -> Success a -> m)
-> (forall m a. Monoid m => (a -> m) -> Success a -> m)
-> (forall a b. (a -> b -> b) -> b -> Success a -> b)
-> (forall a b. (a -> b -> b) -> b -> Success a -> b)
-> (forall b a. (b -> a -> b) -> b -> Success a -> b)
-> (forall b a. (b -> a -> b) -> b -> Success a -> b)
-> (forall a. (a -> a -> a) -> Success a -> a)
-> (forall a. (a -> a -> a) -> Success a -> a)
-> (forall a. Success a -> [a])
-> (forall a. Success a -> Bool)
-> (forall a. Success a -> Int)
-> (forall a. Eq a => a -> Success a -> Bool)
-> (forall a. Ord a => Success a -> a)
-> (forall a. Ord a => Success a -> a)
-> (forall a. Num a => Success a -> a)
-> (forall a. Num a => Success a -> a)
-> Foldable Success
forall a. Eq a => a -> Success a -> Bool
forall a. Num a => Success a -> a
forall a. Ord a => Success a -> a
forall m. Monoid m => Success m -> m
forall a. Success a -> Bool
forall a. Success a -> Int
forall a. Success a -> [a]
forall a. (a -> a -> a) -> Success a -> a
forall m a. Monoid m => (a -> m) -> Success a -> m
forall b a. (b -> a -> b) -> b -> Success a -> b
forall a b. (a -> b -> b) -> b -> Success a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Success m -> m
fold :: forall m. Monoid m => Success m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Success a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Success a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Success a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Success a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Success a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Success a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Success a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Success a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Success a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Success a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Success a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Success a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Success a -> a
foldr1 :: forall a. (a -> a -> a) -> Success a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Success a -> a
foldl1 :: forall a. (a -> a -> a) -> Success a -> a
$ctoList :: forall a. Success a -> [a]
toList :: forall a. Success a -> [a]
$cnull :: forall a. Success a -> Bool
null :: forall a. Success a -> Bool
$clength :: forall a. Success a -> Int
length :: forall a. Success a -> Int
$celem :: forall a. Eq a => a -> Success a -> Bool
elem :: forall a. Eq a => a -> Success a -> Bool
$cmaximum :: forall a. Ord a => Success a -> a
maximum :: forall a. Ord a => Success a -> a
$cminimum :: forall a. Ord a => Success a -> a
minimum :: forall a. Ord a => Success a -> a
$csum :: forall a. Num a => Success a -> a
sum :: forall a. Num a => Success a -> a
$cproduct :: forall a. Num a => Success a -> a
product :: forall a. Num a => Success a -> a
Foldable, Functor Success
Foldable Success
(Functor Success, Foldable Success) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Success a -> f (Success b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Success (f a) -> f (Success a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Success a -> m (Success b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Success (m a) -> m (Success a))
-> Traversable Success
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Success (m a) -> m (Success a)
forall (f :: * -> *) a.
Applicative f =>
Success (f a) -> f (Success a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Success a -> m (Success b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Success a -> f (Success b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Success a -> f (Success b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Success a -> f (Success b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Success (f a) -> f (Success a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Success (f a) -> f (Success a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Success a -> m (Success b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Success a -> m (Success b)
$csequence :: forall (m :: * -> *) a. Monad m => Success (m a) -> m (Success a)
sequence :: forall (m :: * -> *) a. Monad m => Success (m a) -> m (Success a)
Traversable)

-- | Product of all 'BlockComponent's. As this is a GADT, generating random
-- values of it (and combinations!) is not so simple. Therefore, we just
-- always request all block components.
allComponents :: BlockComponent blk (AllComponents blk)
allComponents :: forall blk. BlockComponent blk (AllComponents blk)
allComponents = (,,,,,,,,,,)
    (blk
 -> blk
 -> ByteString
 -> Header blk
 -> ByteString
 -> HeaderHash blk
 -> SlotNo
 -> IsEBB
 -> SizeInBytes
 -> Word16
 -> SomeSecond (NestedCtxt Header) blk
 -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
     SlotNo, IsEBB, SizeInBytes, Word16,
     SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk blk
-> BlockComponent
     blk
     (blk
      -> ByteString
      -> Header blk
      -> ByteString
      -> HeaderHash blk
      -> SlotNo
      -> IsEBB
      -> SizeInBytes
      -> Word16
      -> SomeSecond (NestedCtxt Header) blk
      -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockComponent blk blk
forall blk. BlockComponent blk blk
GetVerifiedBlock
    BlockComponent
  blk
  (blk
   -> ByteString
   -> Header blk
   -> ByteString
   -> HeaderHash blk
   -> SlotNo
   -> IsEBB
   -> SizeInBytes
   -> Word16
   -> SomeSecond (NestedCtxt Header) blk
   -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk blk
-> BlockComponent
     blk
     (ByteString
      -> Header blk
      -> ByteString
      -> HeaderHash blk
      -> SlotNo
      -> IsEBB
      -> SizeInBytes
      -> Word16
      -> SomeSecond (NestedCtxt Header) blk
      -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk blk
forall blk. BlockComponent blk blk
GetBlock
    BlockComponent
  blk
  (ByteString
   -> Header blk
   -> ByteString
   -> HeaderHash blk
   -> SlotNo
   -> IsEBB
   -> SizeInBytes
   -> Word16
   -> SomeSecond (NestedCtxt Header) blk
   -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk ByteString
-> BlockComponent
     blk
     (Header blk
      -> ByteString
      -> HeaderHash blk
      -> SlotNo
      -> IsEBB
      -> SizeInBytes
      -> Word16
      -> SomeSecond (NestedCtxt Header) blk
      -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk ByteString
forall blk. BlockComponent blk ByteString
GetRawBlock
    BlockComponent
  blk
  (Header blk
   -> ByteString
   -> HeaderHash blk
   -> SlotNo
   -> IsEBB
   -> SizeInBytes
   -> Word16
   -> SomeSecond (NestedCtxt Header) blk
   -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk (Header blk)
-> BlockComponent
     blk
     (ByteString
      -> HeaderHash blk
      -> SlotNo
      -> IsEBB
      -> SizeInBytes
      -> Word16
      -> SomeSecond (NestedCtxt Header) blk
      -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk (Header blk)
forall blk. BlockComponent blk (Header blk)
GetHeader
    BlockComponent
  blk
  (ByteString
   -> HeaderHash blk
   -> SlotNo
   -> IsEBB
   -> SizeInBytes
   -> Word16
   -> SomeSecond (NestedCtxt Header) blk
   -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk ByteString
-> BlockComponent
     blk
     (HeaderHash blk
      -> SlotNo
      -> IsEBB
      -> SizeInBytes
      -> Word16
      -> SomeSecond (NestedCtxt Header) blk
      -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk ByteString
forall blk. BlockComponent blk ByteString
GetRawHeader
    BlockComponent
  blk
  (HeaderHash blk
   -> SlotNo
   -> IsEBB
   -> SizeInBytes
   -> Word16
   -> SomeSecond (NestedCtxt Header) blk
   -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk (HeaderHash blk)
-> BlockComponent
     blk
     (SlotNo
      -> IsEBB
      -> SizeInBytes
      -> Word16
      -> SomeSecond (NestedCtxt Header) blk
      -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk (HeaderHash blk)
forall blk. BlockComponent blk (HeaderHash blk)
GetHash
    BlockComponent
  blk
  (SlotNo
   -> IsEBB
   -> SizeInBytes
   -> Word16
   -> SomeSecond (NestedCtxt Header) blk
   -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk SlotNo
-> BlockComponent
     blk
     (IsEBB
      -> SizeInBytes
      -> Word16
      -> SomeSecond (NestedCtxt Header) blk
      -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk SlotNo
forall blk. BlockComponent blk SlotNo
GetSlot
    BlockComponent
  blk
  (IsEBB
   -> SizeInBytes
   -> Word16
   -> SomeSecond (NestedCtxt Header) blk
   -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk IsEBB
-> BlockComponent
     blk
     (SizeInBytes
      -> Word16
      -> SomeSecond (NestedCtxt Header) blk
      -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk IsEBB
forall blk. BlockComponent blk IsEBB
GetIsEBB
    BlockComponent
  blk
  (SizeInBytes
   -> Word16
   -> SomeSecond (NestedCtxt Header) blk
   -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk SizeInBytes
-> BlockComponent
     blk
     (Word16
      -> SomeSecond (NestedCtxt Header) blk
      -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk SizeInBytes
forall blk. BlockComponent blk SizeInBytes
GetBlockSize
    BlockComponent
  blk
  (Word16
   -> SomeSecond (NestedCtxt Header) blk
   -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk Word16
-> BlockComponent
     blk
     (SomeSecond (NestedCtxt Header) blk
      -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
          SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk Word16
forall blk. BlockComponent blk Word16
GetHeaderSize
    BlockComponent
  blk
  (SomeSecond (NestedCtxt Header) blk
   -> (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
       SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) blk))
-> BlockComponent blk (SomeSecond (NestedCtxt Header) blk)
-> BlockComponent
     blk
     (blk, blk, ByteString, Header blk, ByteString, HeaderHash blk,
      SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) blk)
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk (SomeSecond (NestedCtxt Header) blk)
forall blk. BlockComponent blk (SomeSecond (NestedCtxt Header) blk)
GetNestedCtxt

-- | A list of all the 'BlockComponent' indices (@b@) we are interested in.
type AllComponents blk =
  ( blk
  , blk
  , ByteString
  , Header blk
  , ByteString
  , HeaderHash blk
  , SlotNo
  , IsEBB
  , SizeInBytes
  , Word16
  , SomeSecond (NestedCtxt Header) blk
  )

-- | Short-hand
type TestIterator m = WithEq (Iterator m TestBlock (AllComponents TestBlock))

closeOpenIterators :: StrictTVar IO [TestIterator IO] -> IO ()
closeOpenIterators :: StrictTVar IO [TestIterator IO] -> IO ()
closeOpenIterators StrictTVar IO [TestIterator IO]
varIters = do
    [WithEq
   (Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock))]
its <- STM
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
-> IO
     [WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))]
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM
   IO
   [WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock))]
 -> IO
      [WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))])
-> STM
     IO
     [WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))]
-> IO
     [WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))]
forall a b. (a -> b) -> a -> b
$ StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
-> STM
     IO
     [WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))]
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar IO [TestIterator IO]
StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
varIters STM
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
-> STM ()
-> STM
     [WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))]
forall a b. STM a -> STM b -> STM a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
-> [WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock))]
-> STM IO ()
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
StrictTVar m a -> a -> STM m ()
writeTVar StrictTVar IO [TestIterator IO]
StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
varIters []
    (Iterator
   IO
   TestBlock
   (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
    TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
    SomeSecond (NestedCtxt Header) TestBlock)
 -> IO ())
-> [Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock)]
-> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Iterator
  IO
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> IO ()
Iterator
  IO
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> HasCallStack => IO ()
forall (m :: * -> *) blk b.
Iterator m blk b -> HasCallStack => m ()
iteratorClose (WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
-> Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock)
forall a. WithEq a -> a
unWithEq (WithEq
   (Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock))
 -> Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock))
-> [WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock))]
-> [Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [WithEq
   (Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock))]
its)

open :: ImmutableDbArgs Identity IO TestBlock -> IO ImmutableDBState
open :: ImmutableDbArgs Identity IO TestBlock -> IO ImmutableDBState
open ImmutableDbArgs Identity IO TestBlock
args = do
    (ImmutableDB IO TestBlock
db, Internal IO TestBlock
internal) <- ImmutableDbArgs Identity IO TestBlock
-> (forall h.
    WithTempRegistry
      (OpenState IO TestBlock h)
      IO
      ((ImmutableDB IO TestBlock, Internal IO TestBlock),
       OpenState IO TestBlock h)
    -> IO (ImmutableDB IO TestBlock, Internal IO TestBlock))
-> IO (ImmutableDB IO TestBlock, Internal IO TestBlock)
forall (m :: * -> *) blk ans.
(IOLike m, GetPrevHash blk, ConvertRawHash blk,
 ImmutableDbSerialiseConstraints blk, HasCallStack) =>
Complete ImmutableDbArgs m blk
-> (forall h.
    WithTempRegistry
      (OpenState m blk h)
      m
      ((ImmutableDB m blk, Internal m blk), OpenState m blk h)
    -> ans)
-> ans
openDBInternal ImmutableDbArgs Identity IO TestBlock
args WithTempRegistry
  (OpenState IO TestBlock h)
  IO
  ((ImmutableDB IO TestBlock, Internal IO TestBlock),
   OpenState IO TestBlock h)
-> IO (ImmutableDB IO TestBlock, Internal IO TestBlock)
forall h.
WithTempRegistry
  (OpenState IO TestBlock h)
  IO
  ((ImmutableDB IO TestBlock, Internal IO TestBlock),
   OpenState IO TestBlock h)
-> IO (ImmutableDB IO TestBlock, Internal IO TestBlock)
forall (m :: * -> *) st a.
(MonadSTM m, MonadMask m, MonadThread m, HasCallStack) =>
WithTempRegistry st m (a, st) -> m a
runWithTempRegistry
    ImmutableDBState -> IO ImmutableDBState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ImmutableDBState { ImmutableDB IO TestBlock
db :: ImmutableDB IO TestBlock
db :: ImmutableDB IO TestBlock
db, Internal IO TestBlock
internal :: Internal IO TestBlock
internal :: Internal IO TestBlock
internal }

-- | Opens a new ImmutableDB and stores it in 'varDB'.
--
-- Does not close the current VolatileDB stored in 'varDB'.
reopen :: ImmutableDBEnv -> ValidationPolicy -> IO ()
reopen :: ImmutableDBEnv -> ValidationPolicy -> IO ()
reopen ImmutableDBEnv { StrictTVar IO ImmutableDBState
varDB :: ImmutableDBEnv -> StrictTVar IO ImmutableDBState
varDB :: StrictTVar IO ImmutableDBState
varDB, ImmutableDbArgs Identity IO TestBlock
args :: ImmutableDbArgs Identity IO TestBlock
args :: ImmutableDBEnv -> ImmutableDbArgs Identity IO TestBlock
args } ValidationPolicy
valPol = do
    ImmutableDBState
immutableDbState <- ImmutableDbArgs Identity IO TestBlock -> IO ImmutableDBState
open ImmutableDbArgs Identity IO TestBlock
args { immValidationPolicy = valPol }
    IO ImmutableDBState -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ImmutableDBState -> IO ()) -> IO ImmutableDBState -> IO ()
forall a b. (a -> b) -> a -> b
$ STM IO ImmutableDBState -> IO ImmutableDBState
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO ImmutableDBState -> IO ImmutableDBState)
-> STM IO ImmutableDBState -> IO ImmutableDBState
forall a b. (a -> b) -> a -> b
$ StrictTVar IO ImmutableDBState
-> ImmutableDBState -> STM IO ImmutableDBState
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> a -> STM m a
swapTVar StrictTVar IO ImmutableDBState
varDB ImmutableDBState
immutableDbState

-- | Run the command against the given database.
run ::
     HasCallStack
  => ImmutableDBEnv
  -> Cmd (TestIterator IO)
  -> IO (Success (TestIterator IO))
run :: HasCallStack =>
ImmutableDBEnv
-> Cmd (TestIterator IO) -> IO (Success (TestIterator IO))
run env :: ImmutableDBEnv
env@ImmutableDBEnv {
        StrictTVar IO ImmutableDBState
varDB :: ImmutableDBEnv -> StrictTVar IO ImmutableDBState
varDB :: StrictTVar IO ImmutableDBState
varDB
      , StrictTVar IO Id
varNextId :: StrictTVar IO Id
varNextId :: ImmutableDBEnv -> StrictTVar IO Id
varNextId
      , StrictTVar IO [TestIterator IO]
varIters :: StrictTVar IO [TestIterator IO]
varIters :: ImmutableDBEnv -> StrictTVar IO [TestIterator IO]
varIters
      , args :: ImmutableDBEnv -> ImmutableDbArgs Identity IO TestBlock
args = ImmutableDbArgs {
            immRegistry :: forall (f :: * -> *) (m :: * -> *) blk.
ImmutableDbArgs f m blk -> HKD f (ResourceRegistry m)
immRegistry = HKD Identity (ResourceRegistry IO)
registry
          , immHasFS :: forall (f :: * -> *) (m :: * -> *) blk.
ImmutableDbArgs f m blk -> HKD f (SomeHasFS m)
immHasFS = SomeHasFS HasFS IO h
hasFS
          }
      } Cmd (TestIterator IO)
cmd =
    StrictTVar IO ImmutableDBState -> IO ImmutableDBState
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO StrictTVar IO ImmutableDBState
varDB IO ImmutableDBState
-> (ImmutableDBState
    -> IO
         (Success
            (WithEq
               (Iterator
                  IO
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock)))))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ImmutableDBState { ImmutableDB IO TestBlock
db :: ImmutableDBState -> ImmutableDB IO TestBlock
db :: ImmutableDB IO TestBlock
db, Internal IO TestBlock
internal :: ImmutableDBState -> Internal IO TestBlock
internal :: Internal IO TestBlock
internal } -> case Cmd (TestIterator IO)
cmd of
      Cmd (TestIterator IO)
GetTip               -> WithOrigin (Tip TestBlock)
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. WithOrigin (Tip TestBlock) -> Success it
ImmTip          (WithOrigin (Tip TestBlock)
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO (WithOrigin (Tip TestBlock))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM IO (WithOrigin (Tip TestBlock))
-> IO (WithOrigin (Tip TestBlock))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (ImmutableDB IO TestBlock -> STM IO (WithOrigin (Tip TestBlock))
forall (m :: * -> *) blk.
HasCallStack =>
ImmutableDB m blk -> STM m (WithOrigin (Tip blk))
getTip            ImmutableDB IO TestBlock
db)
      GetBlockComponent RealPoint TestBlock
pt -> Either (MissingBlock TestBlock) (AllComponents TestBlock)
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
Either
  (MissingBlock TestBlock)
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it.
Either (MissingBlock TestBlock) (AllComponents TestBlock)
-> Success it
ErAllComponents (Either
   (MissingBlock TestBlock)
   (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
    TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
    SomeSecond (NestedCtxt Header) TestBlock)
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO
     (Either
        (MissingBlock TestBlock)
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>             ImmutableDB IO TestBlock
-> BlockComponent
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock)
-> RealPoint TestBlock
-> IO
     (Either
        (MissingBlock TestBlock)
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))
forall (m :: * -> *) blk b.
HasCallStack =>
ImmutableDB m blk
-> BlockComponent blk b
-> RealPoint blk
-> m (Either (MissingBlock blk) b)
getBlockComponent ImmutableDB IO TestBlock
db BlockComponent TestBlock (AllComponents TestBlock)
BlockComponent
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
forall blk. BlockComponent blk (AllComponents blk)
allComponents RealPoint TestBlock
pt
      AppendBlock TestBlock
blk      -> ()
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. () -> Success it
Unit            (()
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO ()
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>             ImmutableDB IO TestBlock -> TestBlock -> IO ()
forall (m :: * -> *) blk.
HasCallStack =>
ImmutableDB m blk -> blk -> m ()
appendBlock       ImmutableDB IO TestBlock
db TestBlock
blk
      Stream StreamFrom TestBlock
f StreamTo TestBlock
t           -> Either
  (MissingBlock TestBlock)
  (Iterator IO TestBlock (AllComponents TestBlock))
-> IO (Success (TestIterator IO))
Either
  (MissingBlock TestBlock)
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
iter            (Either
   (MissingBlock TestBlock)
   (Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock))
 -> IO
      (Success
         (WithEq
            (Iterator
               IO
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock)))))
-> IO
     (Either
        (MissingBlock TestBlock)
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<             ImmutableDB IO TestBlock
-> ResourceRegistry IO
-> BlockComponent
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock)
-> StreamFrom TestBlock
-> StreamTo TestBlock
-> IO
     (Either
        (MissingBlock TestBlock)
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall (m :: * -> *) blk b.
HasCallStack =>
ImmutableDB m blk
-> ResourceRegistry m
-> BlockComponent blk b
-> StreamFrom blk
-> StreamTo blk
-> m (Either (MissingBlock blk) (Iterator m blk b))
stream            ImmutableDB IO TestBlock
db HKD Identity (ResourceRegistry IO)
ResourceRegistry IO
registry BlockComponent TestBlock (AllComponents TestBlock)
BlockComponent
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
forall blk. BlockComponent blk (AllComponents blk)
allComponents StreamFrom TestBlock
f StreamTo TestBlock
t
      Cmd (TestIterator IO)
StreamAll            -> [AllComponents TestBlock]
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
[(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
  SomeSecond (NestedCtxt Header) TestBlock)]
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. [AllComponents TestBlock] -> Success it
IterResults     ([(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)]
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO
     [(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock)]
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>             ImmutableDB IO TestBlock -> IO [AllComponents TestBlock]
streamAll         ImmutableDB IO TestBlock
db
      IteratorNext    TestIterator IO
it   -> IteratorResult (AllComponents TestBlock)
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
IteratorResult
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. IteratorResult (AllComponents TestBlock) -> Success it
IterResult      (IteratorResult
   (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
    TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
    SomeSecond (NestedCtxt Header) TestBlock)
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO
     (IteratorResult
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>             Iterator
  IO
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> HasCallStack =>
   IO
     (IteratorResult
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))
forall (m :: * -> *) blk b.
Iterator m blk b -> HasCallStack => m (IteratorResult b)
iteratorNext      (WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
-> Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock)
forall a. WithEq a -> a
unWithEq TestIterator IO
WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
it)
      IteratorHasNext TestIterator IO
it   -> Maybe (RealPoint TestBlock)
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. Maybe (RealPoint TestBlock) -> Success it
IterHasNext     (Maybe (RealPoint TestBlock)
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO (Maybe (RealPoint TestBlock))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM IO (Maybe (RealPoint TestBlock))
-> IO (Maybe (RealPoint TestBlock))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (Iterator
  IO
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> HasCallStack => STM IO (Maybe (RealPoint TestBlock))
forall (m :: * -> *) blk b.
Iterator m blk b -> HasCallStack => STM m (Maybe (RealPoint blk))
iteratorHasNext   (WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
-> Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock)
forall a. WithEq a -> a
unWithEq TestIterator IO
WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
it))
      IteratorClose   TestIterator IO
it   -> ()
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. () -> Success it
Unit            (()
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO ()
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>             TestIterator IO -> IO ()
iteratorClose'              TestIterator IO
it
      DeleteAfter WithOrigin (Tip TestBlock)
tip -> do
        StrictTVar IO [TestIterator IO] -> IO ()
closeOpenIterators StrictTVar IO [TestIterator IO]
varIters
        ()
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. () -> Success it
Unit (()
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO ()
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Internal IO TestBlock -> WithOrigin (Tip TestBlock) -> IO ()
forall (m :: * -> *) blk.
HasCallStack =>
Internal m blk -> WithOrigin (Tip blk) -> m ()
deleteAfter Internal IO TestBlock
internal WithOrigin (Tip TestBlock)
tip
      GetHashForSlot SlotNo
slot -> do
        Maybe TestHeaderHash
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. Maybe TestHeaderHash -> Success it
HashForSlot (Maybe TestHeaderHash
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO (Maybe TestHeaderHash)
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Internal IO TestBlock
-> SlotNo -> IO (Maybe (HeaderHash TestBlock))
forall (m :: * -> *) blk.
HasCallStack =>
Internal m blk -> SlotNo -> m (Maybe (HeaderHash blk))
getHashForSlot Internal IO TestBlock
internal SlotNo
slot
      Reopen ValidationPolicy
valPol -> do
        StrictTVar IO [TestIterator IO] -> IO ()
closeOpenIterators StrictTVar IO [TestIterator IO]
varIters
        ImmutableDB IO TestBlock -> IO ()
forall (m :: * -> *) blk. HasCallStack => ImmutableDB m blk -> m ()
closeDB ImmutableDB IO TestBlock
db
        ImmutableDBEnv -> ValidationPolicy -> IO ()
reopen ImmutableDBEnv
env ValidationPolicy
valPol
        ImmutableDB IO TestBlock
db' <- ImmutableDBEnv -> IO (ImmutableDB IO TestBlock)
getImmutableDB ImmutableDBEnv
env
        WithOrigin (Tip TestBlock)
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. WithOrigin (Tip TestBlock) -> Success it
ImmTip (WithOrigin (Tip TestBlock)
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO (WithOrigin (Tip TestBlock))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM IO (WithOrigin (Tip TestBlock))
-> IO (WithOrigin (Tip TestBlock))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (ImmutableDB IO TestBlock -> STM IO (WithOrigin (Tip TestBlock))
forall (m :: * -> *) blk.
HasCallStack =>
ImmutableDB m blk -> STM m (WithOrigin (Tip blk))
getTip ImmutableDB IO TestBlock
db')
      Migrate ValidationPolicy
valPol -> do
        StrictTVar IO [TestIterator IO] -> IO ()
closeOpenIterators StrictTVar IO [TestIterator IO]
varIters
        ImmutableDB IO TestBlock -> IO ()
forall (m :: * -> *) blk. HasCallStack => ImmutableDB m blk -> m ()
closeDB ImmutableDB IO TestBlock
db
        HasFS IO h -> IO ()
forall (m :: * -> *) h. Monad m => HasFS m h -> m ()
unmigrate HasFS IO h
hasFS
        ImmutableDBEnv -> ValidationPolicy -> IO ()
reopen ImmutableDBEnv
env ValidationPolicy
valPol
        ImmutableDB IO TestBlock
db' <- ImmutableDBEnv -> IO (ImmutableDB IO TestBlock)
getImmutableDB ImmutableDBEnv
env
        WithOrigin (Tip TestBlock)
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. WithOrigin (Tip TestBlock) -> Success it
ImmTip (WithOrigin (Tip TestBlock)
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO (WithOrigin (Tip TestBlock))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM IO (WithOrigin (Tip TestBlock))
-> IO (WithOrigin (Tip TestBlock))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (ImmutableDB IO TestBlock -> STM IO (WithOrigin (Tip TestBlock))
forall (m :: * -> *) blk.
HasCallStack =>
ImmutableDB m blk -> STM m (WithOrigin (Tip blk))
getTip ImmutableDB IO TestBlock
db')
      Corruption (MkCorruption Corruptions
corrs) -> do
        StrictTVar IO [TestIterator IO] -> IO ()
closeOpenIterators StrictTVar IO [TestIterator IO]
varIters
        ImmutableDB IO TestBlock -> IO ()
forall (m :: * -> *) blk. HasCallStack => ImmutableDB m blk -> m ()
closeDB ImmutableDB IO TestBlock
db
        Corruptions -> ((FileCorruption, FsPath) -> IO Bool) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Corruptions
corrs (((FileCorruption, FsPath) -> IO Bool) -> IO ())
-> ((FileCorruption, FsPath) -> IO Bool) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FileCorruption
corr, FsPath
file) -> HasFS IO h -> FileCorruption -> FsPath -> IO Bool
forall (m :: * -> *) h.
MonadThrow m =>
HasFS m h -> FileCorruption -> FsPath -> m Bool
corruptFile HasFS IO h
hasFS FileCorruption
corr FsPath
file
        ImmutableDBEnv -> ValidationPolicy -> IO ()
reopen ImmutableDBEnv
env ValidationPolicy
ValidateAllChunks
        ImmutableDB IO TestBlock
db' <- ImmutableDBEnv -> IO (ImmutableDB IO TestBlock)
getImmutableDB ImmutableDBEnv
env
        WithOrigin (Tip TestBlock)
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. WithOrigin (Tip TestBlock) -> Success it
ImmTip (WithOrigin (Tip TestBlock)
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO (WithOrigin (Tip TestBlock))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM IO (WithOrigin (Tip TestBlock))
-> IO (WithOrigin (Tip TestBlock))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (ImmutableDB IO TestBlock -> STM IO (WithOrigin (Tip TestBlock))
forall (m :: * -> *) blk.
HasCallStack =>
ImmutableDB m blk -> STM m (WithOrigin (Tip blk))
getTip ImmutableDB IO TestBlock
db')
  where
    -- Store the iterator in 'varIters'
    iter ::
         Either
           (MissingBlock TestBlock)
           (Iterator IO TestBlock (AllComponents TestBlock))
      -> IO (Success (TestIterator IO))
    iter :: Either
  (MissingBlock TestBlock)
  (Iterator IO TestBlock (AllComponents TestBlock))
-> IO (Success (TestIterator IO))
iter (Left MissingBlock TestBlock
e)   = Success
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
  (MissingBlock TestBlock)
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. Either (MissingBlock TestBlock) it -> Success it
Iter (MissingBlock TestBlock
-> Either
     (MissingBlock TestBlock)
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall a b. a -> Either a b
Left MissingBlock TestBlock
e))
    iter (Right Iterator IO TestBlock (AllComponents TestBlock)
it) = do
      WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
it' <- Iterator
  IO
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> IO
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall a. a -> IO (WithEq a)
giveWithEq Iterator IO TestBlock (AllComponents TestBlock)
Iterator
  IO
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
it
      STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO () -> IO ()) -> STM IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
-> ([WithEq
       (Iterator
          IO
          TestBlock
          (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
           TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
           SomeSecond (NestedCtxt Header) TestBlock))]
    -> [WithEq
          (Iterator
             IO
             TestBlock
             (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
              TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
              SomeSecond (NestedCtxt Header) TestBlock))])
-> STM IO ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar StrictTVar IO [TestIterator IO]
StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
varIters (WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
it'WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
-> [WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock))]
-> [WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock))]
forall a. a -> [a] -> [a]
:)
      Success
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either
  (MissingBlock TestBlock)
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. Either (MissingBlock TestBlock) it -> Success it
Iter (WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
-> Either
     (MissingBlock TestBlock)
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall a b. b -> Either a b
Right WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
it'))

    -- Remove the iterator from 'varIters'
    iteratorClose' :: TestIterator IO -> IO ()
    iteratorClose' :: TestIterator IO -> IO ()
iteratorClose' TestIterator IO
it = do
      STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO () -> IO ()) -> STM IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
-> ([WithEq
       (Iterator
          IO
          TestBlock
          (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
           TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
           SomeSecond (NestedCtxt Header) TestBlock))]
    -> [WithEq
          (Iterator
             IO
             TestBlock
             (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
              TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
              SomeSecond (NestedCtxt Header) TestBlock))])
-> STM IO ()
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m a -> (a -> a) -> STM m ()
modifyTVar StrictTVar IO [TestIterator IO]
StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
varIters (WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
-> [WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock))]
-> [WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock))]
forall a. Eq a => a -> [a] -> [a]
delete TestIterator IO
WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
it)
      Iterator
  IO
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> HasCallStack => IO ()
forall (m :: * -> *) blk b.
Iterator m blk b -> HasCallStack => m ()
iteratorClose (WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
-> Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock)
forall a. WithEq a -> a
unWithEq TestIterator IO
WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
it)

    giveWithEq :: a -> IO (WithEq a)
    giveWithEq :: forall a. a -> IO (WithEq a)
giveWithEq a
a =
      (Id -> WithEq a) -> IO Id -> IO (WithEq a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Id -> a -> WithEq a
forall a. Id -> a -> WithEq a
`WithEq` a
a) (IO Id -> IO (WithEq a)) -> IO Id -> IO (WithEq a)
forall a b. (a -> b) -> a -> b
$ STM IO Id -> IO Id
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO Id -> IO Id) -> STM IO Id -> IO Id
forall a b. (a -> b) -> a -> b
$ StrictTVar IO Id -> (Id -> (Id, Id)) -> STM IO Id
forall (m :: * -> *) s a.
MonadSTM m =>
StrictTVar m s -> (s -> (a, s)) -> STM m a
stateTVar StrictTVar IO Id
varNextId ((Id -> (Id, Id)) -> STM IO Id) -> (Id -> (Id, Id)) -> STM IO Id
forall a b. (a -> b) -> a -> b
$ \Id
i -> (Id
i, Id -> Id
forall a. Enum a => a -> a
succ Id
i)

    streamAll :: ImmutableDB IO TestBlock -> IO [AllComponents TestBlock]
    streamAll :: ImmutableDB IO TestBlock -> IO [AllComponents TestBlock]
streamAll ImmutableDB IO TestBlock
db =
      IO
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
-> (Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock)
    -> IO ())
-> (Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock)
    -> IO
         [(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
           TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
           SomeSecond (NestedCtxt Header) TestBlock)])
-> IO
     [(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock)]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        (ImmutableDB IO TestBlock
-> ResourceRegistry IO
-> BlockComponent
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock)
-> IO
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))
forall (m :: * -> *) blk b.
(MonadSTM m, MonadThrow m, HasHeader blk, HasCallStack) =>
ImmutableDB m blk
-> ResourceRegistry m
-> BlockComponent blk b
-> m (Iterator m blk b)
ImmutableDB.streamAll ImmutableDB IO TestBlock
db HKD Identity (ResourceRegistry IO)
ResourceRegistry IO
registry BlockComponent TestBlock (AllComponents TestBlock)
BlockComponent
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
forall blk. BlockComponent blk (AllComponents blk)
allComponents)
        Iterator
  IO
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> IO ()
Iterator
  IO
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> HasCallStack => IO ()
forall (m :: * -> *) blk b.
Iterator m blk b -> HasCallStack => m ()
iteratorClose
        Iterator
  IO
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> IO
     [(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock)]
forall (m :: * -> *) blk b.
(HasCallStack, Monad m) =>
Iterator m blk b -> m [b]
iteratorToList

-- | To test migration from "XXXXX.epoch" to "XXXXX.chunk" do the opposite
-- renaming, i.e., /unmigrate/ while the database is closed. When the database
-- is reopened, it should trigger the migration code.
unmigrate :: Monad m => HasFS m h -> m ()
unmigrate :: forall (m :: * -> *) h. Monad m => HasFS m h -> m ()
unmigrate HasFS { HasCallStack => FsPath -> m (Set String)
listDirectory :: HasCallStack => FsPath -> m (Set String)
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
listDirectory, HasCallStack => FsPath -> FsPath -> m ()
renameFile :: HasCallStack => FsPath -> FsPath -> m ()
renameFile :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
renameFile } = do
    (Set ChunkNo
chunkFiles, Set ChunkNo
_, Set ChunkNo
_) <- Set String -> (Set ChunkNo, Set ChunkNo, Set ChunkNo)
dbFilesOnDisk (Set String -> (Set ChunkNo, Set ChunkNo, Set ChunkNo))
-> m (Set String) -> m (Set ChunkNo, Set ChunkNo, Set ChunkNo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => FsPath -> m (Set String)
FsPath -> m (Set String)
listDirectory ([String] -> FsPath
mkFsPath [])
    Set ChunkNo -> (ChunkNo -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Set ChunkNo
chunkFiles ((ChunkNo -> m ()) -> m ()) -> (ChunkNo -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \ChunkNo
chunk ->
      HasCallStack => FsPath -> FsPath -> m ()
FsPath -> FsPath -> m ()
renameFile (ChunkNo -> FsPath
fsPathChunkFile ChunkNo
chunk) (Text -> ChunkNo -> FsPath
renderFile Text
"epoch" ChunkNo
chunk)

{-------------------------------------------------------------------------------
  Instantiating the semantics
-------------------------------------------------------------------------------}

-- | Responses are either successful termination or an error.
newtype Resp it = Resp { forall it.
Resp it -> Either (ImmutableDBError TestBlock) (Success it)
getResp :: Either (ImmutableDBError TestBlock) (Success it) }
  deriving (Resp it -> Resp it -> Bool
(Resp it -> Resp it -> Bool)
-> (Resp it -> Resp it -> Bool) -> Eq (Resp it)
forall it. Eq it => Resp it -> Resp it -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall it. Eq it => Resp it -> Resp it -> Bool
== :: Resp it -> Resp it -> Bool
$c/= :: forall it. Eq it => Resp it -> Resp it -> Bool
/= :: Resp it -> Resp it -> Bool
Eq, (forall a b. (a -> b) -> Resp a -> Resp b)
-> (forall a b. a -> Resp b -> Resp a) -> Functor Resp
forall a b. a -> Resp b -> Resp a
forall a b. (a -> b) -> Resp a -> Resp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Resp a -> Resp b
fmap :: forall a b. (a -> b) -> Resp a -> Resp b
$c<$ :: forall a b. a -> Resp b -> Resp a
<$ :: forall a b. a -> Resp b -> Resp a
Functor, (forall m. Monoid m => Resp m -> m)
-> (forall m a. Monoid m => (a -> m) -> Resp a -> m)
-> (forall m a. Monoid m => (a -> m) -> Resp a -> m)
-> (forall a b. (a -> b -> b) -> b -> Resp a -> b)
-> (forall a b. (a -> b -> b) -> b -> Resp a -> b)
-> (forall b a. (b -> a -> b) -> b -> Resp a -> b)
-> (forall b a. (b -> a -> b) -> b -> Resp a -> b)
-> (forall a. (a -> a -> a) -> Resp a -> a)
-> (forall a. (a -> a -> a) -> Resp a -> a)
-> (forall a. Resp a -> [a])
-> (forall a. Resp a -> Bool)
-> (forall a. Resp a -> Int)
-> (forall a. Eq a => a -> Resp a -> Bool)
-> (forall a. Ord a => Resp a -> a)
-> (forall a. Ord a => Resp a -> a)
-> (forall a. Num a => Resp a -> a)
-> (forall a. Num a => Resp a -> a)
-> Foldable Resp
forall a. Eq a => a -> Resp a -> Bool
forall a. Num a => Resp a -> a
forall a. Ord a => Resp a -> a
forall m. Monoid m => Resp m -> m
forall a. Resp a -> Bool
forall a. Resp a -> Int
forall a. Resp a -> [a]
forall a. (a -> a -> a) -> Resp a -> a
forall m a. Monoid m => (a -> m) -> Resp a -> m
forall b a. (b -> a -> b) -> b -> Resp a -> b
forall a b. (a -> b -> b) -> b -> Resp a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Resp m -> m
fold :: forall m. Monoid m => Resp m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Resp a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Resp a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Resp a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Resp a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Resp a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Resp a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Resp a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Resp a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Resp a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Resp a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Resp a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Resp a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Resp a -> a
foldr1 :: forall a. (a -> a -> a) -> Resp a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Resp a -> a
foldl1 :: forall a. (a -> a -> a) -> Resp a -> a
$ctoList :: forall a. Resp a -> [a]
toList :: forall a. Resp a -> [a]
$cnull :: forall a. Resp a -> Bool
null :: forall a. Resp a -> Bool
$clength :: forall a. Resp a -> Int
length :: forall a. Resp a -> Int
$celem :: forall a. Eq a => a -> Resp a -> Bool
elem :: forall a. Eq a => a -> Resp a -> Bool
$cmaximum :: forall a. Ord a => Resp a -> a
maximum :: forall a. Ord a => Resp a -> a
$cminimum :: forall a. Ord a => Resp a -> a
minimum :: forall a. Ord a => Resp a -> a
$csum :: forall a. Num a => Resp a -> a
sum :: forall a. Num a => Resp a -> a
$cproduct :: forall a. Num a => Resp a -> a
product :: forall a. Num a => Resp a -> a
Foldable, Functor Resp
Foldable Resp
(Functor Resp, Foldable Resp) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Resp a -> f (Resp b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Resp (f a) -> f (Resp a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Resp a -> m (Resp b))
-> (forall (m :: * -> *) a. Monad m => Resp (m a) -> m (Resp a))
-> Traversable Resp
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Resp (m a) -> m (Resp a)
forall (f :: * -> *) a. Applicative f => Resp (f a) -> f (Resp a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Resp a -> m (Resp b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Resp a -> f (Resp b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Resp a -> f (Resp b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Resp a -> f (Resp b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Resp (f a) -> f (Resp a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Resp (f a) -> f (Resp a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Resp a -> m (Resp b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Resp a -> m (Resp b)
$csequence :: forall (m :: * -> *) a. Monad m => Resp (m a) -> m (Resp a)
sequence :: forall (m :: * -> *) a. Monad m => Resp (m a) -> m (Resp a)
Traversable, Int -> Resp it -> ShowS
[Resp it] -> ShowS
Resp it -> String
(Int -> Resp it -> ShowS)
-> (Resp it -> String) -> ([Resp it] -> ShowS) -> Show (Resp it)
forall it. Show it => Int -> Resp it -> ShowS
forall it. Show it => [Resp it] -> ShowS
forall it. Show it => Resp it -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall it. Show it => Int -> Resp it -> ShowS
showsPrec :: Int -> Resp it -> ShowS
$cshow :: forall it. Show it => Resp it -> String
show :: Resp it -> String
$cshowList :: forall it. Show it => [Resp it] -> ShowS
showList :: [Resp it] -> ShowS
Show)

-- | Run the pure command against the given database.
runPure ::
     Cmd IteratorId
  -> DBModel TestBlock
  -> (Resp IteratorId, DBModel TestBlock)
runPure :: Cmd Int -> DBModel TestBlock -> (Resp Int, DBModel TestBlock)
runPure = \case
    Cmd Int
GetTip               -> (WithOrigin (Tip TestBlock) -> Success Int)
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok WithOrigin (Tip TestBlock) -> Success Int
forall it. WithOrigin (Tip TestBlock) -> Success it
ImmTip          ((DBModel TestBlock
  -> (Either
        (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
      DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock -> WithOrigin (Tip TestBlock))
-> DBModel TestBlock
-> (Either
      (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
    DBModel TestBlock)
forall {b} {b} {a}. (b -> b) -> b -> (Either a b, b)
query     DBModel TestBlock -> WithOrigin (Tip TestBlock)
forall blk. GetHeader blk => DBModel blk -> WithOrigin (Tip blk)
getTipModel
    GetBlockComponent RealPoint TestBlock
pt -> (Either
   (MissingBlock TestBlock)
   (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
    TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
    SomeSecond (NestedCtxt Header) TestBlock)
 -> Success Int)
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock)
          (Either
             (MissingBlock TestBlock)
             (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
              TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
              SomeSecond (NestedCtxt Header) TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok Either (MissingBlock TestBlock) (AllComponents TestBlock)
-> Success Int
Either
  (MissingBlock TestBlock)
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> Success Int
forall it.
Either (MissingBlock TestBlock) (AllComponents TestBlock)
-> Success it
ErAllComponents ((DBModel TestBlock
  -> (Either
        (ImmutableDBError TestBlock)
        (Either
           (MissingBlock TestBlock)
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)),
      DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock)
          (Either
             (MissingBlock TestBlock)
             (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
              TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
              SomeSecond (NestedCtxt Header) TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock
 -> Either
      (MissingBlock TestBlock)
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock))
-> DBModel TestBlock
-> (Either
      (ImmutableDBError TestBlock)
      (Either
         (MissingBlock TestBlock)
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock)),
    DBModel TestBlock)
forall {b} {b} {a}. (b -> b) -> b -> (Either a b, b)
query    (BlockComponent
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> RealPoint TestBlock
-> DBModel TestBlock
-> Either
     (MissingBlock TestBlock)
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock)
forall blk b.
(HasHeader blk, GetHeader blk, EncodeDisk blk blk,
 HasNestedContent Header blk,
 EncodeDiskDep (NestedCtxt Header) blk) =>
BlockComponent blk b
-> RealPoint blk -> DBModel blk -> Either (MissingBlock blk) b
getBlockComponentModel BlockComponent TestBlock (AllComponents TestBlock)
BlockComponent
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
forall blk. BlockComponent blk (AllComponents blk)
allComponents RealPoint TestBlock
pt)
    AppendBlock TestBlock
blk      -> (() -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok () -> Success Int
forall it. () -> Success it
Unit            ((DBModel TestBlock
  -> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock
 -> Either (ImmutableDBError TestBlock) (DBModel TestBlock))
-> DBModel TestBlock
-> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock)
forall {b} {a}. (b -> Either a b) -> b -> (Either a (), b)
updateE_ (TestBlock
-> DBModel TestBlock
-> Either (ImmutableDBError TestBlock) (DBModel TestBlock)
forall blk.
(HasHeader blk, GetHeader blk, HasCallStack) =>
blk -> DBModel blk -> Either (ImmutableDBError blk) (DBModel blk)
appendBlockModel TestBlock
blk)
    Stream StreamFrom TestBlock
f StreamTo TestBlock
t           -> (Either (MissingBlock TestBlock) Int -> Success Int)
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (Either (MissingBlock TestBlock) Int),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok Either (MissingBlock TestBlock) Int -> Success Int
forall it. Either (MissingBlock TestBlock) it -> Success it
Iter            ((DBModel TestBlock
  -> (Either
        (ImmutableDBError TestBlock) (Either (MissingBlock TestBlock) Int),
      DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (Either (MissingBlock TestBlock) Int),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock
 -> Either
      (ImmutableDBError TestBlock)
      (Either (MissingBlock TestBlock) (Int, DBModel TestBlock)))
-> DBModel TestBlock
-> (Either
      (ImmutableDBError TestBlock) (Either (MissingBlock TestBlock) Int),
    DBModel TestBlock)
forall e a.
(DBModel TestBlock
 -> Either
      (ImmutableDBError TestBlock) (Either e (a, DBModel TestBlock)))
-> DBModel TestBlock
-> (Either (ImmutableDBError TestBlock) (Either e a),
    DBModel TestBlock)
updateEE (StreamFrom TestBlock
-> StreamTo TestBlock
-> DBModel TestBlock
-> Either
     (ImmutableDBError TestBlock)
     (Either (MissingBlock TestBlock) (Int, DBModel TestBlock))
forall blk.
(HasHeader blk, GetHeader blk, HasCallStack) =>
StreamFrom blk
-> StreamTo blk
-> DBModel blk
-> Either
     (ImmutableDBError blk)
     (Either (MissingBlock blk) (Int, DBModel blk))
streamModel StreamFrom TestBlock
f StreamTo TestBlock
t)
    Cmd Int
StreamAll            -> ([(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)]
 -> Success Int)
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock)
          [(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)],
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok [AllComponents TestBlock] -> Success Int
[(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
  SomeSecond (NestedCtxt Header) TestBlock)]
-> Success Int
forall it. [AllComponents TestBlock] -> Success it
IterResults     ((DBModel TestBlock
  -> (Either
        (ImmutableDBError TestBlock)
        [(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock)],
      DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock)
          [(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)],
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock
 -> [(TestBlock, TestBlock, ByteString, Header TestBlock,
      ByteString, TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock)])
-> DBModel TestBlock
-> (Either
      (ImmutableDBError TestBlock)
      [(TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
        TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
        SomeSecond (NestedCtxt Header) TestBlock)],
    DBModel TestBlock)
forall {b} {b} {a}. (b -> b) -> b -> (Either a b, b)
query    (BlockComponent
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> DBModel TestBlock
-> [(TestBlock, TestBlock, ByteString, Header TestBlock,
     ByteString, TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
     SomeSecond (NestedCtxt Header) TestBlock)]
forall blk b.
(HasHeader blk, GetHeader blk, EncodeDisk blk blk,
 HasNestedContent Header blk,
 EncodeDiskDep (NestedCtxt Header) blk) =>
BlockComponent blk b -> DBModel blk -> [b]
streamAllModel BlockComponent TestBlock (AllComponents TestBlock)
BlockComponent
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
forall blk. BlockComponent blk (AllComponents blk)
allComponents)
    IteratorNext    Int
it   -> (IteratorResult
   (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
    TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
    SomeSecond (NestedCtxt Header) TestBlock)
 -> Success Int)
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock)
          (IteratorResult
             (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
              TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
              SomeSecond (NestedCtxt Header) TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok IteratorResult (AllComponents TestBlock) -> Success Int
IteratorResult
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
-> Success Int
forall it. IteratorResult (AllComponents TestBlock) -> Success it
IterResult      ((DBModel TestBlock
  -> (Either
        (ImmutableDBError TestBlock)
        (IteratorResult
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)),
      DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock)
          (IteratorResult
             (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
              TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
              SomeSecond (NestedCtxt Header) TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock
 -> (IteratorResult
       (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
        TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
        SomeSecond (NestedCtxt Header) TestBlock),
     DBModel TestBlock))
-> DBModel TestBlock
-> (Either
      (ImmutableDBError TestBlock)
      (IteratorResult
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock)),
    DBModel TestBlock)
forall {p :: * -> * -> *} {t} {a} {c} {a}.
Bifunctor p =>
(t -> p a c) -> t -> p (Either a a) c
update   (Int
-> BlockComponent
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock)
-> DBModel TestBlock
-> (IteratorResult
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock),
    DBModel TestBlock)
forall blk b.
(HasHeader blk, GetHeader blk, EncodeDisk blk blk,
 HasNestedContent Header blk,
 EncodeDiskDep (NestedCtxt Header) blk) =>
Int
-> BlockComponent blk b
-> DBModel blk
-> (IteratorResult b, DBModel blk)
iteratorNextModel Int
it BlockComponent TestBlock (AllComponents TestBlock)
BlockComponent
  TestBlock
  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
   SomeSecond (NestedCtxt Header) TestBlock)
forall blk. BlockComponent blk (AllComponents blk)
allComponents)
    IteratorHasNext Int
it   -> (Maybe (RealPoint TestBlock) -> Success Int)
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (Maybe (RealPoint TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok Maybe (RealPoint TestBlock) -> Success Int
forall it. Maybe (RealPoint TestBlock) -> Success it
IterHasNext     ((DBModel TestBlock
  -> (Either
        (ImmutableDBError TestBlock) (Maybe (RealPoint TestBlock)),
      DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (Maybe (RealPoint TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock -> Maybe (RealPoint TestBlock))
-> DBModel TestBlock
-> (Either
      (ImmutableDBError TestBlock) (Maybe (RealPoint TestBlock)),
    DBModel TestBlock)
forall {b} {b} {a}. (b -> b) -> b -> (Either a b, b)
query    (Int -> DBModel TestBlock -> Maybe (RealPoint TestBlock)
forall blk.
HasHeader blk =>
Int -> DBModel blk -> Maybe (RealPoint blk)
iteratorHasNextModel Int
it)
    IteratorClose   Int
it   -> (() -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok () -> Success Int
forall it. () -> Success it
Unit            ((DBModel TestBlock
  -> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock -> DBModel TestBlock)
-> DBModel TestBlock
-> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock)
forall {t} {b} {a}. (t -> b) -> t -> (Either a (), b)
update_  (Int -> DBModel TestBlock -> DBModel TestBlock
forall blk. Int -> DBModel blk -> DBModel blk
iteratorCloseModel Int
it)
    DeleteAfter WithOrigin (Tip TestBlock)
tip      -> (() -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok () -> Success Int
forall it. () -> Success it
Unit            ((DBModel TestBlock
  -> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock -> DBModel TestBlock)
-> DBModel TestBlock
-> (Either (ImmutableDBError TestBlock) (), DBModel TestBlock)
forall {t} {b} {a}. (t -> b) -> t -> (Either a (), b)
update_  (WithOrigin (Tip TestBlock)
-> DBModel TestBlock -> DBModel TestBlock
forall blk.
GetHeader blk =>
WithOrigin (Tip blk) -> DBModel blk -> DBModel blk
deleteAfterModel WithOrigin (Tip TestBlock)
tip)
    GetHashForSlot SlotNo
slot  -> (Maybe TestHeaderHash -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) (Maybe TestHeaderHash),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok Maybe TestHeaderHash -> Success Int
forall it. Maybe TestHeaderHash -> Success it
HashForSlot     ((DBModel TestBlock
  -> (Either (ImmutableDBError TestBlock) (Maybe TestHeaderHash),
      DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) (Maybe TestHeaderHash),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock -> Maybe TestHeaderHash)
-> DBModel TestBlock
-> (Either (ImmutableDBError TestBlock) (Maybe TestHeaderHash),
    DBModel TestBlock)
forall {b} {b} {a}. (b -> b) -> b -> (Either a b, b)
query    (SlotNo -> DBModel TestBlock -> Maybe (HeaderHash TestBlock)
forall blk.
HasHeader blk =>
SlotNo -> DBModel blk -> Maybe (HeaderHash blk)
getHashForSlotModel SlotNo
slot)
    Corruption Corruption
corr      -> (WithOrigin (Tip TestBlock) -> Success Int)
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok WithOrigin (Tip TestBlock) -> Success Int
forall it. WithOrigin (Tip TestBlock) -> Success it
ImmTip          ((DBModel TestBlock
  -> (Either
        (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
      DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock
 -> (WithOrigin (Tip TestBlock), DBModel TestBlock))
-> DBModel TestBlock
-> (Either
      (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
    DBModel TestBlock)
forall {p :: * -> * -> *} {t} {a} {c} {a}.
Bifunctor p =>
(t -> p a c) -> t -> p (Either a a) c
update   (Corruptions
-> DBModel TestBlock
-> (WithOrigin (Tip TestBlock), DBModel TestBlock)
forall blk.
(HasHeader blk, GetHeader blk, EncodeDisk blk blk) =>
Corruptions -> DBModel blk -> (WithOrigin (Tip blk), DBModel blk)
simulateCorruptions (Corruption -> Corruptions
getCorruptions Corruption
corr))
    Reopen ValidationPolicy
_             -> (WithOrigin (Tip TestBlock) -> Success Int)
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok WithOrigin (Tip TestBlock) -> Success Int
forall it. WithOrigin (Tip TestBlock) -> Success it
ImmTip          ((DBModel TestBlock
  -> (Either
        (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
      DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock
 -> (WithOrigin (Tip TestBlock), DBModel TestBlock))
-> DBModel TestBlock
-> (Either
      (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
    DBModel TestBlock)
forall {p :: * -> * -> *} {t} {a} {c} {a}.
Bifunctor p =>
(t -> p a c) -> t -> p (Either a a) c
update    DBModel TestBlock
-> (WithOrigin (Tip TestBlock), DBModel TestBlock)
forall blk.
GetHeader blk =>
DBModel blk -> (WithOrigin (Tip blk), DBModel blk)
reopenModel
    Migrate ValidationPolicy
_            -> (WithOrigin (Tip TestBlock) -> Success Int)
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok WithOrigin (Tip TestBlock) -> Success Int
forall it. WithOrigin (Tip TestBlock) -> Success it
ImmTip          ((DBModel TestBlock
  -> (Either
        (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
      DBModel TestBlock))
 -> DBModel TestBlock -> (Resp Int, DBModel TestBlock))
-> (DBModel TestBlock
    -> (Either
          (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
        DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ (DBModel TestBlock
 -> (WithOrigin (Tip TestBlock), DBModel TestBlock))
-> DBModel TestBlock
-> (Either
      (ImmutableDBError TestBlock) (WithOrigin (Tip TestBlock)),
    DBModel TestBlock)
forall {p :: * -> * -> *} {t} {a} {c} {a}.
Bifunctor p =>
(t -> p a c) -> t -> p (Either a a) c
update    DBModel TestBlock
-> (WithOrigin (Tip TestBlock), DBModel TestBlock)
forall blk.
GetHeader blk =>
DBModel blk -> (WithOrigin (Tip blk), DBModel blk)
reopenModel
  where
    query :: (b -> b) -> b -> (Either a b, b)
query  b -> b
f b
m = (b -> Either a b
forall a b. b -> Either a b
Right (b -> b
f b
m), b
m)

    update :: (t -> p a c) -> t -> p (Either a a) c
update   t -> p a c
f t
m = (a -> Either a a) -> p a c -> p (Either a a) c
forall a b c. (a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first a -> Either a a
forall a b. b -> Either a b
Right (t -> p a c
f t
m)
    update_ :: (t -> b) -> t -> (Either a (), b)
update_  t -> b
f t
m = (() -> Either a ()
forall a b. b -> Either a b
Right (), t -> b
f t
m)
    updateE_ :: (b -> Either a b) -> b -> (Either a (), b)
updateE_ b -> Either a b
f b
m = case b -> Either a b
f b
m of
      Left  a
e  -> (a -> Either a ()
forall a b. a -> Either a b
Left a
e, b
m)
      Right b
m' -> (() -> Either a ()
forall a b. b -> Either a b
Right (), b
m')
    updateEE ::
         (DBModel TestBlock -> Either (ImmutableDBError TestBlock) (Either e (a, DBModel TestBlock)))
      -> DBModel TestBlock
      -> (Either (ImmutableDBError TestBlock) (Either e a), DBModel TestBlock)
    updateEE :: forall e a.
(DBModel TestBlock
 -> Either
      (ImmutableDBError TestBlock) (Either e (a, DBModel TestBlock)))
-> DBModel TestBlock
-> (Either (ImmutableDBError TestBlock) (Either e a),
    DBModel TestBlock)
updateEE DBModel TestBlock
-> Either
     (ImmutableDBError TestBlock) (Either e (a, DBModel TestBlock))
f DBModel TestBlock
m = case DBModel TestBlock
-> Either
     (ImmutableDBError TestBlock) (Either e (a, DBModel TestBlock))
f DBModel TestBlock
m of
      Left ImmutableDBError TestBlock
e                -> (ImmutableDBError TestBlock
-> Either (ImmutableDBError TestBlock) (Either e a)
forall a b. a -> Either a b
Left ImmutableDBError TestBlock
e, DBModel TestBlock
m)
      Right (Left e
e)        -> (Either e a -> Either (ImmutableDBError TestBlock) (Either e a)
forall a b. b -> Either a b
Right (e -> Either e a
forall a b. a -> Either a b
Left e
e), DBModel TestBlock
m)
      Right (Right (a
a, DBModel TestBlock
m')) -> (Either e a -> Either (ImmutableDBError TestBlock) (Either e a)
forall a b. b -> Either a b
Right (a -> Either e a
forall a b. b -> Either a b
Right a
a), DBModel TestBlock
m')

    ok ::
         (a -> Success IteratorId)
      -> (DBModel TestBlock -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
      -> DBModel TestBlock
      -> (Resp IteratorId, DBModel TestBlock)
    ok :: forall a.
(a -> Success Int)
-> (DBModel TestBlock
    -> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock))
-> DBModel TestBlock
-> (Resp Int, DBModel TestBlock)
ok a -> Success Int
toSuccess DBModel TestBlock
-> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock)
f DBModel TestBlock
m = (Either (ImmutableDBError TestBlock) a -> Resp Int)
-> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock)
-> (Resp Int, DBModel TestBlock)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Either (ImmutableDBError TestBlock) (Success Int) -> Resp Int
forall it.
Either (ImmutableDBError TestBlock) (Success it) -> Resp it
Resp (Either (ImmutableDBError TestBlock) (Success Int) -> Resp Int)
-> (Either (ImmutableDBError TestBlock) a
    -> Either (ImmutableDBError TestBlock) (Success Int))
-> Either (ImmutableDBError TestBlock) a
-> Resp Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Success Int)
-> Either (ImmutableDBError TestBlock) a
-> Either (ImmutableDBError TestBlock) (Success Int)
forall a b.
(a -> b)
-> Either (ImmutableDBError TestBlock) a
-> Either (ImmutableDBError TestBlock) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Success Int
toSuccess) ((Either (ImmutableDBError TestBlock) a, DBModel TestBlock)
 -> (Resp Int, DBModel TestBlock))
-> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock)
-> (Resp Int, DBModel TestBlock)
forall a b. (a -> b) -> a -> b
$ DBModel TestBlock
-> (Either (ImmutableDBError TestBlock) a, DBModel TestBlock)
f DBModel TestBlock
m

-- | Run a command against the pure model
runPureErr :: DBModel TestBlock
           -> CmdErr IteratorId
           -> (Resp IteratorId, DBModel TestBlock)
runPureErr :: DBModel TestBlock -> CmdErr Int -> (Resp Int, DBModel TestBlock)
runPureErr DBModel TestBlock
dbm (CmdErr Maybe Errors
mbErrors Cmd Int
cmd) =
    case (Maybe Errors
mbErrors, Cmd Int -> DBModel TestBlock -> (Resp Int, DBModel TestBlock)
runPure Cmd Int
cmd DBModel TestBlock
dbm) of
      -- No simulated errors, just step
      (Maybe Errors
Nothing, (Resp Int
resp, DBModel TestBlock
dbm')) -> (Resp Int
resp, DBModel TestBlock
dbm')
      -- An error will be simulated and thrown (not here, but in the real
      -- implementation). To mimic what the implementation will do, we only
      -- have to close the iterators, as the truncation during the reopening
      -- of the database will erase any changes.
      (Just Errors
_, (Resp Int
_resp, DBModel TestBlock
dbm')) ->
        -- We ignore the updated @dbm'@, because we have to roll back to the
        -- state before executing cmd. The only exception is the DeleteAfter
        -- cmd, in which case we have to roll back to the requested tip.
        --
        -- As the implementation closes all iterators, we do the same.
        let dbm'' :: DBModel TestBlock
dbm'' = DBModel TestBlock -> DBModel TestBlock
forall blk. DBModel blk -> DBModel blk
closeAllIterators (DBModel TestBlock -> DBModel TestBlock)
-> DBModel TestBlock -> DBModel TestBlock
forall a b. (a -> b) -> a -> b
$ case Cmd Int
cmd of
              DeleteAfter WithOrigin (Tip TestBlock)
_ -> DBModel TestBlock
dbm'
              Cmd Int
_             -> DBModel TestBlock
dbm
        in (Either (ImmutableDBError TestBlock) (Success Int) -> Resp Int
forall it.
Either (ImmutableDBError TestBlock) (Success it) -> Resp it
Resp (Either (ImmutableDBError TestBlock) (Success Int) -> Resp Int)
-> Either (ImmutableDBError TestBlock) (Success Int) -> Resp Int
forall a b. (a -> b) -> a -> b
$ Success Int -> Either (ImmutableDBError TestBlock) (Success Int)
forall a b. b -> Either a b
Right (Success Int -> Either (ImmutableDBError TestBlock) (Success Int))
-> Success Int -> Either (ImmutableDBError TestBlock) (Success Int)
forall a b. (a -> b) -> a -> b
$ WithOrigin (Tip TestBlock) -> Success Int
forall it. WithOrigin (Tip TestBlock) -> Success it
ImmTip (WithOrigin (Tip TestBlock) -> Success Int)
-> WithOrigin (Tip TestBlock) -> Success Int
forall a b. (a -> b) -> a -> b
$ DBModel TestBlock -> WithOrigin (Tip TestBlock)
forall blk. GetHeader blk => DBModel blk -> WithOrigin (Tip blk)
dbmTip DBModel TestBlock
dbm'', DBModel TestBlock
dbm'')

{-------------------------------------------------------------------------------
  Collect arguments
-------------------------------------------------------------------------------}

-- | Collect all iterators created. For example, @t@ could be 'Cmd' or 'CmdErr'.
iters :: Traversable t => t it -> [it]
iters :: forall (t :: * -> *) it. Traversable t => t it -> [it]
iters = t it -> [it]
forall a. t a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

{-------------------------------------------------------------------------------
  Model
-------------------------------------------------------------------------------}

-- | Concrete or symbolic references to a real (or model) iterator
type IterRef m = Reference (Opaque (TestIterator m))

-- | Mapping between iterator references and mocked iterators
type KnownIters m = RefEnv (Opaque (TestIterator m))
                           IteratorId

-- | Execution model
data Model m r = Model
  { forall (m :: * -> *) (r :: * -> *). Model m r -> DBModel TestBlock
dbModel    :: DBModel TestBlock
    -- ^ A model of the database, used as state for the 'HasImmutableDB'
    -- instance of 'ModelDB'.
  , forall (m :: * -> *) (r :: * -> *). Model m r -> KnownIters m r
knownIters :: KnownIters m r
    -- ^ Store a mapping between iterator references and mocked iterators.
  } deriving (Int -> Model m r -> ShowS
[Model m r] -> ShowS
Model m r -> String
(Int -> Model m r -> ShowS)
-> (Model m r -> String)
-> ([Model m r] -> ShowS)
-> Show (Model m r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) (r :: * -> *).
Show1 r =>
Int -> Model m r -> ShowS
forall (m :: * -> *) (r :: * -> *). Show1 r => [Model m r] -> ShowS
forall (m :: * -> *) (r :: * -> *). Show1 r => Model m r -> String
$cshowsPrec :: forall (m :: * -> *) (r :: * -> *).
Show1 r =>
Int -> Model m r -> ShowS
showsPrec :: Int -> Model m r -> ShowS
$cshow :: forall (m :: * -> *) (r :: * -> *). Show1 r => Model m r -> String
show :: Model m r -> String
$cshowList :: forall (m :: * -> *) (r :: * -> *). Show1 r => [Model m r] -> ShowS
showList :: [Model m r] -> ShowS
Show, (forall x. Model m r -> Rep (Model m r) x)
-> (forall x. Rep (Model m r) x -> Model m r)
-> Generic (Model m r)
forall x. Rep (Model m r) x -> Model m r
forall x. Model m r -> Rep (Model m r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) (r :: * -> *) x.
Rep (Model m r) x -> Model m r
forall (m :: * -> *) (r :: * -> *) x.
Model m r -> Rep (Model m r) x
$cfrom :: forall (m :: * -> *) (r :: * -> *) x.
Model m r -> Rep (Model m r) x
from :: forall x. Model m r -> Rep (Model m r) x
$cto :: forall (m :: * -> *) (r :: * -> *) x.
Rep (Model m r) x -> Model m r
to :: forall x. Rep (Model m r) x -> Model m r
Generic)

nbOpenIterators :: Model m r -> Int
nbOpenIterators :: forall (m :: * -> *) (r :: * -> *). Model m r -> Int
nbOpenIterators Model m r
model = [(Reference
    (Opaque
       (WithEq
          (Iterator
             m
             TestBlock
             (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
              TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
              SomeSecond (NestedCtxt Header) TestBlock))))
    r,
  Int)]
-> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (RefEnv
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Int
  r
-> [(Reference
       (Opaque
          (WithEq
             (Iterator
                m
                TestBlock
                (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                 TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                 SomeSecond (NestedCtxt Header) TestBlock))))
       r,
     Int)]
forall k a (r :: * -> *). RefEnv k a r -> [(Reference k r, a)]
RE.toList (Model m r -> KnownIters m r
forall (m :: * -> *) (r :: * -> *). Model m r -> KnownIters m r
knownIters Model m r
model))

-- | Initial model
initModel :: DBModel TestBlock -> Model m r
initModel :: forall (m :: * -> *) (r :: * -> *). DBModel TestBlock -> Model m r
initModel DBModel TestBlock
dbModel = Model { knownIters :: KnownIters m r
knownIters  = KnownIters m r
RefEnv
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Int
  r
forall k a (r :: * -> *). RefEnv k a r
RE.empty, DBModel TestBlock
dbModel :: DBModel TestBlock
dbModel :: DBModel TestBlock
dbModel }

-- | Key property of the model is that we can go from real to mock responses
toMock :: (Functor t, Eq1 r)
       => Model m r -> At t m r -> t IteratorId
toMock :: forall (t :: * -> *) (r :: * -> *) (m :: * -> *).
(Functor t, Eq1 r) =>
Model m r -> At t m r -> t Int
toMock Model {KnownIters m r
DBModel TestBlock
dbModel :: forall (m :: * -> *) (r :: * -> *). Model m r -> DBModel TestBlock
knownIters :: forall (m :: * -> *) (r :: * -> *). Model m r -> KnownIters m r
dbModel :: DBModel TestBlock
knownIters :: KnownIters m r
..} (At t (IterRef m r)
t) = (Reference
   (Opaque
      (WithEq
         (Iterator
            m
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
   r
 -> Int)
-> t (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        r)
-> t Int
forall a b. (a -> b) -> t a -> t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (KnownIters m r
RefEnv
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Int
  r
knownIters RefEnv
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Int
  r
-> Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r
-> Int
forall k (r :: * -> *) a.
(Eq k, Eq1 r) =>
RefEnv k a r -> Reference k r -> a
RE.!) t (IterRef m r)
t (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r)
t

-- | Step the mock semantics
step :: Eq1 r
     => Model m r
     -> At CmdErr m r
     -> (Resp IteratorId, DBModel TestBlock)
step :: forall (r :: * -> *) (m :: * -> *).
Eq1 r =>
Model m r -> At CmdErr m r -> (Resp Int, DBModel TestBlock)
step model :: Model m r
model@Model{KnownIters m r
DBModel TestBlock
dbModel :: forall (m :: * -> *) (r :: * -> *). Model m r -> DBModel TestBlock
knownIters :: forall (m :: * -> *) (r :: * -> *). Model m r -> KnownIters m r
dbModel :: DBModel TestBlock
knownIters :: KnownIters m r
..} At CmdErr m r
cmdErr = DBModel TestBlock -> CmdErr Int -> (Resp Int, DBModel TestBlock)
runPureErr DBModel TestBlock
dbModel (Model m r -> At CmdErr m r -> CmdErr Int
forall (t :: * -> *) (r :: * -> *) (m :: * -> *).
(Functor t, Eq1 r) =>
Model m r -> At t m r -> t Int
toMock Model m r
model At CmdErr m r
cmdErr)

{-------------------------------------------------------------------------------
  Wrapping in quickcheck-state-machine references
-------------------------------------------------------------------------------}

-- | Instantiate functor @t@ to @t ('IterRef' m r)@.
--
-- Needed because we need to (partially) apply @'At' t m@ to @r@.
newtype At t m r = At { forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
At t m r -> t (IterRef m r)
unAt :: t (IterRef m r) }
  deriving ((forall x. At t m r -> Rep (At t m r) x)
-> (forall x. Rep (At t m r) x -> At t m r) -> Generic (At t m r)
forall x. Rep (At t m r) x -> At t m r
forall x. At t m r -> Rep (At t m r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (t :: * -> *) (m :: * -> *) (r :: * -> *) x.
Rep (At t m r) x -> At t m r
forall (t :: * -> *) (m :: * -> *) (r :: * -> *) x.
At t m r -> Rep (At t m r) x
$cfrom :: forall (t :: * -> *) (m :: * -> *) (r :: * -> *) x.
At t m r -> Rep (At t m r) x
from :: forall x. At t m r -> Rep (At t m r) x
$cto :: forall (t :: * -> *) (m :: * -> *) (r :: * -> *) x.
Rep (At t m r) x -> At t m r
to :: forall x. Rep (At t m r) x -> At t m r
Generic)

deriving instance Show (t (IterRef m r)) => Show (At t m r)

deriving instance Eq1 r => Eq (At Resp m r)

deriving instance Generic1          (At Cmd m)
deriving instance Rank2.Foldable    (At Cmd m)
deriving instance Rank2.Functor     (At Cmd m)
deriving instance Rank2.Traversable (At Cmd m)

deriving instance Generic1          (At CmdErr m)
deriving instance Rank2.Foldable    (At CmdErr m)
deriving instance Rank2.Functor     (At CmdErr m)
deriving instance Rank2.Traversable (At CmdErr m)

deriving instance Generic1          (At Resp m)
deriving instance Rank2.Foldable    (At Resp m)


{-------------------------------------------------------------------------------
  Events
-------------------------------------------------------------------------------}

-- | An event records the model before and after a command along with the
-- command itself, and a mocked version of the response.
data Event m r = Event
  { forall (m :: * -> *) (r :: * -> *). Event m r -> Model m r
eventBefore   :: Model     m r
  , forall (m :: * -> *) (r :: * -> *). Event m r -> At CmdErr m r
eventCmdErr   :: At CmdErr m r
  , forall (m :: * -> *) (r :: * -> *). Event m r -> Model m r
eventAfter    :: Model     m r
  , forall (m :: * -> *) (r :: * -> *). Event m r -> Resp Int
eventMockResp :: Resp IteratorId
  } deriving (Int -> Event m r -> ShowS
[Event m r] -> ShowS
Event m r -> String
(Int -> Event m r -> ShowS)
-> (Event m r -> String)
-> ([Event m r] -> ShowS)
-> Show (Event m r)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (m :: * -> *) (r :: * -> *).
Show1 r =>
Int -> Event m r -> ShowS
forall (m :: * -> *) (r :: * -> *). Show1 r => [Event m r] -> ShowS
forall (m :: * -> *) (r :: * -> *). Show1 r => Event m r -> String
$cshowsPrec :: forall (m :: * -> *) (r :: * -> *).
Show1 r =>
Int -> Event m r -> ShowS
showsPrec :: Int -> Event m r -> ShowS
$cshow :: forall (m :: * -> *) (r :: * -> *). Show1 r => Event m r -> String
show :: Event m r -> String
$cshowList :: forall (m :: * -> *) (r :: * -> *). Show1 r => [Event m r] -> ShowS
showList :: [Event m r] -> ShowS
Show)

eventCmdNoErr :: Event m r -> At Cmd m r
eventCmdNoErr :: forall (m :: * -> *) (r :: * -> *). Event m r -> At Cmd m r
eventCmdNoErr = Cmd (IterRef m r) -> At Cmd m r
Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r)
-> At Cmd m r
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
t (IterRef m r) -> At t m r
At (Cmd
   (Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      r)
 -> At Cmd m r)
-> (Event m r
    -> Cmd
         (Reference
            (Opaque
               (WithEq
                  (Iterator
                     m
                     TestBlock
                     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                      SomeSecond (NestedCtxt Header) TestBlock))))
            r))
-> Event m r
-> At Cmd m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmdErr
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r)
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        r)
forall it. CmdErr it -> Cmd it
cmd (CmdErr
   (Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      r)
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         r))
-> (Event m r
    -> CmdErr
         (Reference
            (Opaque
               (WithEq
                  (Iterator
                     m
                     TestBlock
                     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                      SomeSecond (NestedCtxt Header) TestBlock))))
            r))
-> Event m r
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. At CmdErr m r -> CmdErr (IterRef m r)
At CmdErr m r
-> CmdErr
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        r)
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
At t m r -> t (IterRef m r)
unAt (At CmdErr m r
 -> CmdErr
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         r))
-> (Event m r -> At CmdErr m r)
-> Event m r
-> CmdErr
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event m r -> At CmdErr m r
forall (m :: * -> *) (r :: * -> *). Event m r -> At CmdErr m r
eventCmdErr

eventMockCmdNoErr :: Eq1 r => Event m r -> Cmd IteratorId
eventMockCmdNoErr :: forall (r :: * -> *) (m :: * -> *). Eq1 r => Event m r -> Cmd Int
eventMockCmdNoErr ev :: Event m r
ev@Event {At CmdErr m r
Model m r
Resp Int
eventBefore :: forall (m :: * -> *) (r :: * -> *). Event m r -> Model m r
eventCmdErr :: forall (m :: * -> *) (r :: * -> *). Event m r -> At CmdErr m r
eventAfter :: forall (m :: * -> *) (r :: * -> *). Event m r -> Model m r
eventMockResp :: forall (m :: * -> *) (r :: * -> *). Event m r -> Resp Int
eventBefore :: Model m r
eventCmdErr :: At CmdErr m r
eventAfter :: Model m r
eventMockResp :: Resp Int
..} = Model m r -> At Cmd m r -> Cmd Int
forall (t :: * -> *) (r :: * -> *) (m :: * -> *).
(Functor t, Eq1 r) =>
Model m r -> At t m r -> t Int
toMock Model m r
eventBefore (Event m r -> At Cmd m r
forall (m :: * -> *) (r :: * -> *). Event m r -> At Cmd m r
eventCmdNoErr Event m r
ev)


-- | Construct an event
lockstep :: (Show1 r, Eq1 r)
         => Model     m r
         -> At CmdErr m r
         -> At Resp   m r
         -> Event     m r
lockstep :: forall (r :: * -> *) (m :: * -> *).
(Show1 r, Eq1 r) =>
Model m r -> At CmdErr m r -> At Resp m r -> Event m r
lockstep model :: Model m r
model@Model {KnownIters m r
DBModel TestBlock
dbModel :: forall (m :: * -> *) (r :: * -> *). Model m r -> DBModel TestBlock
knownIters :: forall (m :: * -> *) (r :: * -> *). Model m r -> KnownIters m r
dbModel :: DBModel TestBlock
knownIters :: KnownIters m r
..} At CmdErr m r
cmdErr (At Resp (IterRef m r)
resp) = Event
    { eventBefore :: Model m r
eventBefore   = Model m r
model
    , eventCmdErr :: At CmdErr m r
eventCmdErr   = At CmdErr m r
cmdErr
    , eventAfter :: Model m r
eventAfter    = Model m r
model'
    , eventMockResp :: Resp Int
eventMockResp = Resp Int
mockResp
    }
  where
    (Resp Int
mockResp, DBModel TestBlock
dbModel') = Model m r -> At CmdErr m r -> (Resp Int, DBModel TestBlock)
forall (r :: * -> *) (m :: * -> *).
Eq1 r =>
Model m r -> At CmdErr m r -> (Resp Int, DBModel TestBlock)
step Model m r
model At CmdErr m r
cmdErr
    newIters :: RefEnv
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Int
  r
newIters = [(Reference
    (Opaque
       (WithEq
          (Iterator
             m
             TestBlock
             (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
              TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
              SomeSecond (NestedCtxt Header) TestBlock))))
    r,
  Int)]
-> RefEnv
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Int
     r
forall k a (r :: * -> *).
(Eq k, Show k, Eq a, Show a, Eq1 r, Show1 r, HasCallStack) =>
[(Reference k r, a)] -> RefEnv k a r
RE.fromList ([(Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r,
   Int)]
 -> RefEnv
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Int
      r)
-> [(Reference
       (Opaque
          (WithEq
             (Iterator
                m
                TestBlock
                (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                 TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                 SomeSecond (NestedCtxt Header) TestBlock))))
       r,
     Int)]
-> RefEnv
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Int
     r
forall a b. (a -> b) -> a -> b
$ [Reference
   (Opaque
      (WithEq
         (Iterator
            m
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
   r]
-> [Int]
-> [(Reference
       (Opaque
          (WithEq
             (Iterator
                m
                TestBlock
                (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                 TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                 SomeSecond (NestedCtxt Header) TestBlock))))
       r,
     Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Resp
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r)
-> [Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      r]
forall (t :: * -> *) it. Traversable t => t it -> [it]
iters Resp (IterRef m r)
Resp
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r)
resp) (Resp Int -> [Int]
forall (t :: * -> *) it. Traversable t => t it -> [it]
iters Resp Int
mockResp)
    model' :: Model m r
model' = Model m r
model
      { dbModel    = dbModel'
      , knownIters = knownIters `RE.union` newIters
      }

{-------------------------------------------------------------------------------
  Generator
-------------------------------------------------------------------------------}

-- | Generate a 'CmdErr'
generator :: Model m Symbolic -> Gen (At CmdErr m Symbolic)
generator :: forall (m :: * -> *).
Model m Symbolic -> Gen (At CmdErr m Symbolic)
generator Model m Symbolic
m = do
    Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
cmd    <- At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
At Cmd m Symbolic
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
At t m r -> t (IterRef m r)
unAt (At Cmd m Symbolic
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen (At Cmd m Symbolic)
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Model m Symbolic -> Gen (At Cmd m Symbolic)
forall (m :: * -> *). Model m Symbolic -> Gen (At Cmd m Symbolic)
generateCmd Model m Symbolic
m
    Maybe Errors
cmdErr <-
      if Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
-> Bool
forall a. Cmd a -> Bool
errorFor Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
cmd then
        [(Int, Gen (Maybe Errors))] -> Gen (Maybe Errors)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [
            -- We want to make some progress
            (Int
4, Maybe Errors -> Gen (Maybe Errors)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Errors
forall a. Maybe a
Nothing)
          , (Int
1, Errors -> Maybe Errors
forall a. a -> Maybe a
Just (Errors -> Maybe Errors) -> Gen Errors -> Gen (Maybe Errors)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Errors
forall a. Arbitrary a => Gen a
arbitrary)
          ]
       else
         Maybe Errors -> Gen (Maybe Errors)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Errors
forall a. Maybe a
Nothing
    At CmdErr m Symbolic -> Gen (At CmdErr m Symbolic)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (At CmdErr m Symbolic -> Gen (At CmdErr m Symbolic))
-> At CmdErr m Symbolic -> Gen (At CmdErr m Symbolic)
forall a b. (a -> b) -> a -> b
$ CmdErr (IterRef m Symbolic) -> At CmdErr m Symbolic
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
t (IterRef m r) -> At t m r
At CmdErr {Maybe Errors
Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
cmdErr :: Maybe Errors
cmd :: Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
cmd :: Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
cmdErr :: Maybe Errors
..}
  where
    -- Don't simulate an error during corruption, because we don't want an
    -- error to happen while we corrupt a file.
    errorFor :: Cmd it -> Bool
errorFor Corruption {} = Bool
False
    errorFor Cmd it
_             = Bool
True

-- | Generate a 'Cmd'.
generateCmd :: forall m. Model m Symbolic -> Gen (At Cmd m Symbolic)
generateCmd :: forall (m :: * -> *). Model m Symbolic -> Gen (At Cmd m Symbolic)
generateCmd Model {KnownIters m Symbolic
DBModel TestBlock
dbModel :: forall (m :: * -> *) (r :: * -> *). Model m r -> DBModel TestBlock
knownIters :: forall (m :: * -> *) (r :: * -> *). Model m r -> KnownIters m r
dbModel :: DBModel TestBlock
knownIters :: KnownIters m Symbolic
..} = Cmd (IterRef m Symbolic) -> At Cmd m Symbolic
Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
-> At Cmd m Symbolic
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
t (IterRef m r) -> At t m r
At (Cmd
   (Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Symbolic)
 -> At Cmd m Symbolic)
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
-> Gen (At Cmd m Symbolic)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int,
  Gen
    (Cmd
       (Reference
          (Opaque
             (WithEq
                (Iterator
                   m
                   TestBlock
                   (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                    TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                    SomeSecond (NestedCtxt Header) TestBlock))))
          Symbolic)))]
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ -- Block
      (Int
1, RealPoint TestBlock
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. RealPoint TestBlock -> Cmd it
GetBlockComponent (RealPoint TestBlock
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen (RealPoint TestBlock)
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (RealPoint TestBlock)
genGetBlock)
    , (Int
5, TestBlock
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. TestBlock -> Cmd it
AppendBlock (TestBlock
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen TestBlock
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TestBlock
genAppendRegularBlock)
    , (if Bool
modelSupportsEBBs then Int
2 else Int
0, TestBlock
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. TestBlock -> Cmd it
AppendBlock (TestBlock
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen TestBlock
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TestBlock
genAppendEBB)
    , (if Bool
empty then Int
1 else Int
4, Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
forall it. Cmd it
StreamAll)
    , (if Bool
empty then Int
1 else Int
4, (StreamFrom TestBlock
 -> StreamTo TestBlock
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> (StreamFrom TestBlock, StreamTo TestBlock)
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry StreamFrom TestBlock
-> StreamTo TestBlock
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. StreamFrom TestBlock -> StreamTo TestBlock -> Cmd it
Stream ((StreamFrom TestBlock, StreamTo TestBlock)
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen (StreamFrom TestBlock, StreamTo TestBlock)
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (StreamFrom TestBlock, StreamTo TestBlock)
genBounds)
    , (if Bool
noIters then Int
0 else Int
5, Reference
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Symbolic
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. it -> Cmd it
IteratorNext    (Reference
   (Opaque
      (WithEq
         (Iterator
            m
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
   Symbolic
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (IterRef m Symbolic)
Gen
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
pickIter)
    , (if Bool
noIters then Int
0 else Int
5, Reference
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Symbolic
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. it -> Cmd it
IteratorHasNext (Reference
   (Opaque
      (WithEq
         (Iterator
            m
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
   Symbolic
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (IterRef m Symbolic)
Gen
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
pickIter)
    , (if Bool
noIters then Int
0 else Int
1, Reference
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Symbolic
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. it -> Cmd it
IteratorClose   (Reference
   (Opaque
      (WithEq
         (Iterator
            m
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
   Symbolic
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (IterRef m Symbolic)
Gen
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
pickIter)
    , (Int
1, ValidationPolicy
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. ValidationPolicy -> Cmd it
Reopen (ValidationPolicy
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen ValidationPolicy
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ValidationPolicy
genValPol)
    , (Int
1, ValidationPolicy
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. ValidationPolicy -> Cmd it
Migrate (ValidationPolicy
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen ValidationPolicy
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ValidationPolicy
genValPol)
    , (Int
1, WithOrigin (Tip TestBlock)
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. WithOrigin (Tip TestBlock) -> Cmd it
DeleteAfter (WithOrigin (Tip TestBlock)
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen (WithOrigin (Tip TestBlock))
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (WithOrigin (Tip TestBlock))
genTip)
    , (Int
1, SlotNo
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. SlotNo -> Cmd it
GetHashForSlot (SlotNo
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen SlotNo
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
genGetHashForSlot)
    , (if [FsPath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FsPath]
dbFiles then Int
0 else Int
1, Corruption
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. Corruption -> Cmd it
Corruption (Corruption
 -> Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Gen Corruption
-> Gen
     (Cmd
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Corruption
genCorruption)
    ]
  where
    DBModel {Int
Map Int (IteratorModel TestBlock)
Map SlotNo (InSlot TestBlock)
CodecConfig TestBlock
ChunkInfo
dbmChunkInfo :: ChunkInfo
dbmCodecConfig :: CodecConfig TestBlock
dbmIterators :: Map Int (IteratorModel TestBlock)
dbmNextIterator :: Int
dbmSlots :: Map SlotNo (InSlot TestBlock)
dbmChunkInfo :: forall blk. DBModel blk -> ChunkInfo
dbmCodecConfig :: forall blk. DBModel blk -> CodecConfig blk
dbmIterators :: forall blk. DBModel blk -> Map Int (IteratorModel blk)
dbmNextIterator :: forall blk. DBModel blk -> Int
dbmSlots :: forall blk. DBModel blk -> Map SlotNo (InSlot blk)
..} = DBModel TestBlock
dbModel
    modelSupportsEBBs :: Bool
modelSupportsEBBs = ChunkInfo -> Bool
chunkInfoSupportsEBBs ChunkInfo
dbmChunkInfo
    currentEpoch :: EpochNo
currentEpoch      = ChunkNo -> EpochNo
unsafeChunkNoToEpochNo (ChunkNo -> EpochNo) -> ChunkNo -> EpochNo
forall a b. (a -> b) -> a -> b
$ DBModel TestBlock -> ChunkNo
forall blk. HasHeader blk => DBModel blk -> ChunkNo
dbmCurrentChunk DBModel TestBlock
dbModel
    canContainEBB :: SlotNo -> Bool
canContainEBB     = Bool -> SlotNo -> Bool
forall a b. a -> b -> a
const Bool
modelSupportsEBBs -- TODO: we could be more precise

    -- Construct a 'SlotNo' @n@ chunks later
    inLaterChunk :: Word -> SlotNo -> SlotNo
    inLaterChunk :: Word -> SlotNo -> SlotNo
inLaterChunk Word
0 SlotNo
s = SlotNo
s
    inLaterChunk Word
n SlotNo
s = Word -> SlotNo -> SlotNo
inLaterChunk (Word
n Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) (SlotNo -> SlotNo) -> SlotNo -> SlotNo
forall a b. (a -> b) -> a -> b
$
                         Word64 -> SlotNo
SlotNo (SlotNo -> Word64
unSlotNo SlotNo
s Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ ChunkSize -> Word64
numRegularBlocks ChunkSize
size)
      where
        chunk :: ChunkNo
chunk = ChunkInfo -> SlotNo -> ChunkNo
chunkIndexOfSlot ChunkInfo
dbmChunkInfo SlotNo
s
        size :: ChunkSize
size  = ChunkInfo -> ChunkNo -> ChunkSize
getChunkSize     ChunkInfo
dbmChunkInfo ChunkNo
chunk

    lastBlock :: WithOrigin TestBlock
    lastBlock :: WithOrigin TestBlock
lastBlock = DBModel TestBlock -> WithOrigin TestBlock
forall blk. DBModel blk -> WithOrigin blk
dbmTipBlock DBModel TestBlock
dbModel

    lastSlot :: SlotNo
    lastSlot :: SlotNo
lastSlot = SlotNo -> (TestBlock -> SlotNo) -> WithOrigin TestBlock -> SlotNo
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin (Word64 -> SlotNo
SlotNo Word64
0) TestBlock -> SlotNo
forall b. HasHeader b => b -> SlotNo
blockSlot WithOrigin TestBlock
lastBlock

    lastBlockIsEBB :: Bool
    lastBlockIsEBB :: Bool
lastBlockIsEBB = Bool -> (TestBlock -> Bool) -> WithOrigin TestBlock -> Bool
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin Bool
False (IsEBB -> Bool
fromIsEBB (IsEBB -> Bool) -> (TestBlock -> IsEBB) -> TestBlock -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestBlock -> IsEBB
testBlockIsEBB) WithOrigin TestBlock
lastBlock

    dbFiles :: [FsPath]
    dbFiles :: [FsPath]
dbFiles = DBModel TestBlock -> [FsPath]
getDBFiles DBModel TestBlock
dbModel

    blocks :: [TestBlock]
    blocks :: [TestBlock]
blocks = DBModel TestBlock -> [TestBlock]
forall blk. DBModel blk -> [blk]
dbmBlocks DBModel TestBlock
dbModel

    ebbs, regularBlocks :: [TestBlock]
    ([TestBlock]
ebbs, [TestBlock]
regularBlocks) = (TestBlock -> Bool) -> [TestBlock] -> ([TestBlock], [TestBlock])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (IsEBB -> Bool
fromIsEBB (IsEBB -> Bool) -> (TestBlock -> IsEBB) -> TestBlock -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestBlock -> IsEBB
forall blk. GetHeader blk => blk -> IsEBB
blockToIsEBB) [TestBlock]
blocks

    empty, noRegularBlocks, noEBBs :: Bool
    empty :: Bool
empty           = [TestBlock] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestBlock]
blocks
    noRegularBlocks :: Bool
noRegularBlocks = [TestBlock] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestBlock]
regularBlocks
    noEBBs :: Bool
noEBBs          = [TestBlock] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TestBlock]
ebbs

    noIters :: Bool
    noIters :: Bool
noIters = Map Int (IteratorModel TestBlock) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (IteratorModel TestBlock)
dbmIterators

    -- Randomly pick one of the open iterators
    --
    -- PRECONDITION: there is at least one open iterator
    pickIter :: Gen (IterRef m Symbolic)
    pickIter :: Gen (IterRef m Symbolic)
pickIter = [Reference
   (Opaque
      (WithEq
         (Iterator
            m
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
   Symbolic]
-> Gen
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall a. HasCallStack => [a] -> Gen a
elements (RefEnv
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Int
  Symbolic
-> [Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Symbolic]
forall k a (r :: * -> *). RefEnv k a r -> [Reference k r]
RE.keys KnownIters m Symbolic
RefEnv
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Int
  Symbolic
knownIters)

    genRandomPoint :: Gen (RealPoint TestBlock)
    genRandomPoint :: Gen (RealPoint TestBlock)
genRandomPoint =
        SlotNo -> HeaderHash TestBlock -> RealPoint TestBlock
SlotNo -> TestHeaderHash -> RealPoint TestBlock
forall blk. SlotNo -> HeaderHash blk -> RealPoint blk
RealPoint
          (SlotNo -> TestHeaderHash -> RealPoint TestBlock)
-> Gen SlotNo -> Gen (TestHeaderHash -> RealPoint TestBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary
          Gen (TestHeaderHash -> RealPoint TestBlock)
-> Gen TestHeaderHash -> Gen (RealPoint TestBlock)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> TestHeaderHash
TestHeaderHash (Int -> TestHeaderHash) -> Gen Int -> Gen TestHeaderHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
forall a. Arbitrary a => Gen a
arbitrary)

    genGetBlock :: Gen (RealPoint TestBlock)
    genGetBlock :: Gen (RealPoint TestBlock)
genGetBlock = [(Int, Gen (RealPoint TestBlock))] -> Gen (RealPoint TestBlock)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [
          (if Bool
noRegularBlocks then Int
0 else Int
4, [RealPoint TestBlock] -> Gen (RealPoint TestBlock)
forall a. HasCallStack => [a] -> Gen a
elements ((TestBlock -> RealPoint TestBlock)
-> [TestBlock] -> [RealPoint TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint [TestBlock]
regularBlocks))
        , (if Bool
noEBBs          then Int
0 else Int
2, [RealPoint TestBlock] -> Gen (RealPoint TestBlock)
forall a. HasCallStack => [a] -> Gen a
elements ((TestBlock -> RealPoint TestBlock)
-> [TestBlock] -> [RealPoint TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint [TestBlock]
ebbs))
        , (Int
1, Gen (RealPoint TestBlock)
genRandomPoint)
        ]

    genAppendRegularBlock :: Gen TestBlock
    genAppendRegularBlock :: Gen TestBlock
genAppendRegularBlock = do
        SlotNo
slotNo <- [(Int, Gen SlotNo)] -> Gen SlotNo
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [
            -- Slot in the past -> invalid
            (Int
1, (SlotNo, SlotNo) -> Gen SlotNo
chooseSlot (SlotNo
0, SlotNo
lastSlot))
            -- If the previous block is an EBB, make a regular block in
            -- the same slot number. The slot can still be empty, though.
          , (if Bool
lastBlockIsEBB then Int
7 else Int
0, SlotNo -> Gen SlotNo
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return SlotNo
lastSlot)
            -- Slots not too far in the future
          , (Int
4, (SlotNo, SlotNo) -> Gen SlotNo
chooseSlot (SlotNo
lastSlot, SlotNo
lastSlot SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ SlotNo
10))
            -- Slots in some future chunk
          , (Int
1, (SlotNo, SlotNo) -> Gen SlotNo
chooseSlot (Word -> SlotNo -> SlotNo
inLaterChunk Word
1 SlotNo
lastSlot,
                            Word -> SlotNo -> SlotNo
inLaterChunk Word
4 SlotNo
lastSlot))
          ]
        TestBlock -> Gen TestBlock
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestBlock -> Gen TestBlock) -> TestBlock -> Gen TestBlock
forall a b. (a -> b) -> a -> b
$
          ((SlotNo -> TestBody -> TestBlock)
-> (TestBlock -> SlotNo -> TestBody -> TestBlock)
-> WithOrigin TestBlock
-> SlotNo
-> TestBody
-> TestBlock
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin SlotNo -> TestBody -> TestBlock
firstBlock TestBlock -> SlotNo -> TestBody -> TestBlock
mkNextBlock WithOrigin TestBlock
lastBlock)
            SlotNo
slotNo
            (Word -> Bool -> TestBody
TestBody Word
0 Bool
True)

    genAppendEBB :: Gen TestBlock
    genAppendEBB :: Gen TestBlock
genAppendEBB = case WithOrigin TestBlock
lastBlock of
        WithOrigin TestBlock
Origin              -> TestBlock -> Gen TestBlock
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestBlock -> Gen TestBlock) -> TestBlock -> Gen TestBlock
forall a b. (a -> b) -> a -> b
$ (SlotNo -> Bool) -> TestBody -> TestBlock
firstEBB SlotNo -> Bool
canContainEBB (Word -> Bool -> TestBody
TestBody Word
0 Bool
True)
        NotOrigin TestBlock
prevBlock -> do
          EpochNo
epoch <- [(Int, Gen EpochNo)] -> Gen EpochNo
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
          -- Epoch in the past -> invalid
            [ (Int
1, (EpochNo, EpochNo) -> Gen EpochNo
chooseEpoch (EpochNo
0, EpochNo
currentEpoch))
            , (Int
3, (EpochNo, EpochNo) -> Gen EpochNo
chooseEpoch (EpochNo
currentEpoch, EpochNo
currentEpoch EpochNo -> EpochNo -> EpochNo
forall a. Num a => a -> a -> a
+ EpochNo
5))
            ]
          let slotNo :: SlotNo
slotNo = HasCallStack => ChunkInfo -> EpochNo -> SlotNo
ChunkInfo -> EpochNo -> SlotNo
slotNoOfEBB ChunkInfo
dbmChunkInfo EpochNo
epoch
          TestBlock -> Gen TestBlock
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (TestBlock -> Gen TestBlock) -> TestBlock -> Gen TestBlock
forall a b. (a -> b) -> a -> b
$ (SlotNo -> Bool)
-> TestBlock -> SlotNo -> EpochNo -> TestBody -> TestBlock
mkNextEBB SlotNo -> Bool
canContainEBB TestBlock
prevBlock SlotNo
slotNo EpochNo
epoch (Word -> Bool -> TestBody
TestBody Word
0 Bool
True)

    -- Both random points and existing points
    genRandomOrExisting :: Gen (RealPoint TestBlock)
    genRandomOrExisting :: Gen (RealPoint TestBlock)
genRandomOrExisting = [(Int, Gen (RealPoint TestBlock))] -> Gen (RealPoint TestBlock)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [
          (Int
1, Gen (RealPoint TestBlock)
genRandomPoint)
        , (if Bool
empty then Int
0 else Int
1, [RealPoint TestBlock] -> Gen (RealPoint TestBlock)
forall a. HasCallStack => [a] -> Gen a
elements ((TestBlock -> RealPoint TestBlock)
-> [TestBlock] -> [RealPoint TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint [TestBlock]
blocks))
        ]

    genStreamFromWith :: Gen (RealPoint blk) -> Gen (StreamFrom blk)
    genStreamFromWith :: forall blk. Gen (RealPoint blk) -> Gen (StreamFrom blk)
genStreamFromWith Gen (RealPoint blk)
genPoint = [Gen (StreamFrom blk)] -> Gen (StreamFrom blk)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [
          Point blk -> StreamFrom blk
forall blk. Point blk -> StreamFrom blk
StreamFromExclusive (Point blk -> StreamFrom blk)
-> Gen (Point blk) -> Gen (StreamFrom blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen (Point blk))] -> Gen (Point blk)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [
              (Int
1, 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)
            , (Int
4, RealPoint blk -> Point blk
forall blk. RealPoint blk -> Point blk
realPointToPoint (RealPoint blk -> Point blk)
-> Gen (RealPoint blk) -> Gen (Point blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (RealPoint blk)
genPoint)
            ]
        , RealPoint blk -> StreamFrom blk
forall blk. RealPoint blk -> StreamFrom blk
StreamFromInclusive (RealPoint blk -> StreamFrom blk)
-> Gen (RealPoint blk) -> Gen (StreamFrom blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (RealPoint blk)
genPoint
        ]

    genRandomOrExistingStreamFrom :: Gen (StreamFrom TestBlock)
    genRandomOrExistingStreamFrom :: Gen (StreamFrom TestBlock)
genRandomOrExistingStreamFrom = Gen (RealPoint TestBlock) -> Gen (StreamFrom TestBlock)
forall blk. Gen (RealPoint blk) -> Gen (StreamFrom blk)
genStreamFromWith Gen (RealPoint TestBlock)
genRandomOrExisting

    genRandomOrExistingStreamTo :: Gen (StreamTo TestBlock)
    genRandomOrExistingStreamTo :: Gen (StreamTo TestBlock)
genRandomOrExistingStreamTo =
        RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive (RealPoint TestBlock -> StreamTo TestBlock)
-> Gen (RealPoint TestBlock) -> Gen (StreamTo TestBlock)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (RealPoint TestBlock)
genRandomOrExisting

    -- PRECONDITION: not empty
    genStreamFrom :: Gen (StreamFrom TestBlock)
    genStreamFrom :: Gen (StreamFrom TestBlock)
genStreamFrom = Gen (RealPoint TestBlock) -> Gen (StreamFrom TestBlock)
forall blk. Gen (RealPoint blk) -> Gen (StreamFrom blk)
genStreamFromWith ([RealPoint TestBlock] -> Gen (RealPoint TestBlock)
forall a. HasCallStack => [a] -> Gen a
elements ((TestBlock -> RealPoint TestBlock)
-> [TestBlock] -> [RealPoint TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint [TestBlock]
blocks))

    -- Tries to generate an upper bound /after/ the lower bound. This can fail,
    -- i.e., when the lower bound is an exclusive bound corresponding to the
    -- last block. In that case, we give up and use the same block as the upper
    -- bound, resulting in invalid bounds.
    --
    -- PRECONDITION: not empty and the given block exists
    genStreamTo :: StreamFrom TestBlock -> Gen (StreamTo TestBlock)
    genStreamTo :: StreamFrom TestBlock -> Gen (StreamTo TestBlock)
genStreamTo = (RealPoint TestBlock -> StreamTo TestBlock)
-> Gen (RealPoint TestBlock) -> Gen (StreamTo TestBlock)
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RealPoint TestBlock -> StreamTo TestBlock
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive (Gen (RealPoint TestBlock) -> Gen (StreamTo TestBlock))
-> (StreamFrom TestBlock -> Gen (RealPoint TestBlock))
-> StreamFrom TestBlock
-> Gen (StreamTo TestBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
        StreamFromExclusive Point TestBlock
pt -> case Point TestBlock -> WithOrigin (RealPoint TestBlock)
forall blk. Point blk -> WithOrigin (RealPoint blk)
pointToWithOriginRealPoint Point TestBlock
pt of
          WithOrigin (RealPoint TestBlock)
Origin        -> [RealPoint TestBlock] -> Gen (RealPoint TestBlock)
forall a. HasCallStack => [a] -> Gen a
elements ((TestBlock -> RealPoint TestBlock)
-> [TestBlock] -> [RealPoint TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint [TestBlock]
blocks)
          NotOrigin RealPoint TestBlock
pt' -> RealPoint TestBlock -> Gen (RealPoint TestBlock)
genPointAfter RealPoint TestBlock
pt'
        StreamFromInclusive RealPoint TestBlock
pt -> RealPoint TestBlock -> Gen (RealPoint TestBlock)
genPointAfter RealPoint TestBlock
pt
      where
        -- Can generate the given point itself
        genPointAfter :: RealPoint TestBlock -> Gen (RealPoint TestBlock)
        genPointAfter :: RealPoint TestBlock -> Gen (RealPoint TestBlock)
genPointAfter RealPoint TestBlock
pt =
              [RealPoint TestBlock] -> Gen (RealPoint TestBlock)
forall a. HasCallStack => [a] -> Gen a
elements
            ([RealPoint TestBlock] -> Gen (RealPoint TestBlock))
-> ([TestBlock] -> [RealPoint TestBlock])
-> [TestBlock]
-> Gen (RealPoint TestBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RealPoint TestBlock -> Bool)
-> [RealPoint TestBlock] -> [RealPoint TestBlock]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (RealPoint TestBlock -> RealPoint TestBlock -> Bool
forall a. Eq a => a -> a -> Bool
/= RealPoint TestBlock
pt)
            ([RealPoint TestBlock] -> [RealPoint TestBlock])
-> ([TestBlock] -> [RealPoint TestBlock])
-> [TestBlock]
-> [RealPoint TestBlock]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TestBlock -> RealPoint TestBlock)
-> [TestBlock] -> [RealPoint TestBlock]
forall a b. (a -> b) -> [a] -> [b]
map TestBlock -> RealPoint TestBlock
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint
            ([TestBlock] -> Gen (RealPoint TestBlock))
-> [TestBlock] -> Gen (RealPoint TestBlock)
forall a b. (a -> b) -> a -> b
$ [TestBlock]
blocks

    genBounds :: Gen (StreamFrom TestBlock, StreamTo TestBlock)
    genBounds :: Gen (StreamFrom TestBlock, StreamTo TestBlock)
genBounds = [(Int, Gen (StreamFrom TestBlock, StreamTo TestBlock))]
-> Gen (StreamFrom TestBlock, StreamTo TestBlock)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [
        -- Likely an invalid range
          (Int
1, (,) (StreamFrom TestBlock
 -> StreamTo TestBlock
 -> (StreamFrom TestBlock, StreamTo TestBlock))
-> Gen (StreamFrom TestBlock)
-> Gen
     (StreamTo TestBlock -> (StreamFrom TestBlock, StreamTo TestBlock))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (StreamFrom TestBlock)
genRandomOrExistingStreamFrom Gen
  (StreamTo TestBlock -> (StreamFrom TestBlock, StreamTo TestBlock))
-> Gen (StreamTo TestBlock)
-> Gen (StreamFrom TestBlock, StreamTo TestBlock)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (StreamTo TestBlock)
genRandomOrExistingStreamTo)
        -- A valid iterator
        , (if Bool
empty then Int
0 else Int
3, do
             StreamFrom TestBlock
from <- Gen (StreamFrom TestBlock)
genStreamFrom
             StreamTo TestBlock
to   <- StreamFrom TestBlock -> Gen (StreamTo TestBlock)
genStreamTo StreamFrom TestBlock
from
             (StreamFrom TestBlock, StreamTo TestBlock)
-> Gen (StreamFrom TestBlock, StreamTo TestBlock)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (StreamFrom TestBlock
from, StreamTo TestBlock
to))
        ]

    chooseWord64 :: Coercible a Word64 => (a, a) -> Gen a
    chooseWord64 :: forall a. Coercible a Word64 => (a, a) -> Gen a
chooseWord64 (a
start, a
end) = Gen Word64 -> Gen a
forall a b. Coercible a b => a -> b
coerce (Gen Word64 -> Gen a) -> Gen Word64 -> Gen a
forall a b. (a -> b) -> a -> b
$ forall a. Random a => (a, a) -> Gen a
choose @Word64 (a -> Word64
forall a b. Coercible a b => a -> b
coerce a
start, a -> Word64
forall a b. Coercible a b => a -> b
coerce a
end)

    chooseSlot :: (SlotNo, SlotNo) -> Gen SlotNo
    chooseSlot :: (SlotNo, SlotNo) -> Gen SlotNo
chooseSlot = (SlotNo, SlotNo) -> Gen SlotNo
forall a. Coercible a Word64 => (a, a) -> Gen a
chooseWord64

    chooseEpoch :: (EpochNo, EpochNo) -> Gen EpochNo
    chooseEpoch :: (EpochNo, EpochNo) -> Gen EpochNo
chooseEpoch = (EpochNo, EpochNo) -> Gen EpochNo
forall a. Coercible a Word64 => (a, a) -> Gen a
chooseWord64

    genCorruption :: Gen Corruption
    genCorruption :: Gen Corruption
genCorruption = Corruptions -> Corruption
MkCorruption (Corruptions -> Corruption) -> Gen Corruptions -> Gen Corruption
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty FsPath -> Gen Corruptions
generateCorruptions ([FsPath] -> NonEmpty FsPath
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList [FsPath]
dbFiles)

    genValPol :: Gen ValidationPolicy
    genValPol :: Gen ValidationPolicy
genValPol = [ValidationPolicy] -> Gen ValidationPolicy
forall a. HasCallStack => [a] -> Gen a
elements [ValidationPolicy
ValidateMostRecentChunk, ValidationPolicy
ValidateAllChunks]

    genTip :: Gen (WithOrigin (Tip TestBlock))
    genTip :: Gen (WithOrigin (Tip TestBlock))
genTip = [WithOrigin (Tip TestBlock)] -> Gen (WithOrigin (Tip TestBlock))
forall a. HasCallStack => [a] -> Gen a
elements ([WithOrigin (Tip TestBlock)] -> Gen (WithOrigin (Tip TestBlock)))
-> [WithOrigin (Tip TestBlock)] -> Gen (WithOrigin (Tip TestBlock))
forall a b. (a -> b) -> a -> b
$ NonEmpty (WithOrigin (Tip TestBlock))
-> [WithOrigin (Tip TestBlock)]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty (WithOrigin (Tip TestBlock))
 -> [WithOrigin (Tip TestBlock)])
-> NonEmpty (WithOrigin (Tip TestBlock))
-> [WithOrigin (Tip TestBlock)]
forall a b. (a -> b) -> a -> b
$ DBModel TestBlock -> NonEmpty (WithOrigin (Tip TestBlock))
forall blk.
GetHeader blk =>
DBModel blk -> NonEmpty (WithOrigin (Tip blk))
tips DBModel TestBlock
dbModel

    genGetHashForSlot :: Gen SlotNo
    genGetHashForSlot :: Gen SlotNo
genGetHashForSlot = [(Int, Gen SlotNo)] -> Gen SlotNo
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency ([(Int, Gen SlotNo)] -> Gen SlotNo)
-> [(Int, Gen SlotNo)] -> Gen SlotNo
forall a b. (a -> b) -> a -> b
$
        [ (if Bool
empty then Int
0 else Int
3, [SlotNo] -> Gen SlotNo
forall a. HasCallStack => [a] -> Gen a
elements ([SlotNo] -> Gen SlotNo) -> [SlotNo] -> Gen SlotNo
forall a b. (a -> b) -> a -> b
$ Map SlotNo (InSlot TestBlock) -> [SlotNo]
forall k a. Map k a -> [k]
Map.keys Map SlotNo (InSlot TestBlock)
dbmSlots)
        , (Int
2, (SlotNo, SlotNo) -> Gen SlotNo
chooseSlot (SlotNo
0, SlotNo
lastSlot SlotNo -> SlotNo -> SlotNo
forall a. Num a => a -> a -> a
+ SlotNo
5))
        ]

-- | Return the files that the database with the given model would have
-- created. For each epoch an epoch, primary index, and secondary index file.
getDBFiles :: DBModel TestBlock -> [FsPath]
getDBFiles :: DBModel TestBlock -> [FsPath]
getDBFiles DBModel TestBlock
dbm =
    [ FsPath
file
    | ChunkNo
chunk <- ChunkNo -> ChunkNo -> [ChunkNo]
chunksBetween ChunkNo
firstChunkNo (DBModel TestBlock -> ChunkNo
forall blk. HasHeader blk => DBModel blk -> ChunkNo
dbmCurrentChunk DBModel TestBlock
dbm)
    , FsPath
file  <-
      [ ChunkNo -> FsPath
fsPathChunkFile ChunkNo
chunk
      , ChunkNo -> FsPath
fsPathPrimaryIndexFile ChunkNo
chunk
      , ChunkNo -> FsPath
fsPathSecondaryIndexFile ChunkNo
chunk
      ]
    ]

{-------------------------------------------------------------------------------
  Shrinking
-------------------------------------------------------------------------------}

-- | Shrinker
shrinker :: Model m Symbolic -> At CmdErr m Symbolic -> [At CmdErr m Symbolic]
shrinker :: forall (m :: * -> *).
Model m Symbolic -> At CmdErr m Symbolic -> [At CmdErr m Symbolic]
shrinker Model m Symbolic
m (At (CmdErr Maybe Errors
mbErrors Cmd (IterRef m Symbolic)
cmd)) = (CmdErr
   (Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Symbolic)
 -> At CmdErr m Symbolic)
-> [CmdErr
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic)]
-> [At CmdErr m Symbolic]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CmdErr (IterRef m Symbolic) -> At CmdErr m Symbolic
CmdErr
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
-> At CmdErr m Symbolic
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
t (IterRef m r) -> At t m r
At ([CmdErr
    (Reference
       (Opaque
          (WithEq
             (Iterator
                m
                TestBlock
                (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                 TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                 SomeSecond (NestedCtxt Header) TestBlock))))
       Symbolic)]
 -> [At CmdErr m Symbolic])
-> [CmdErr
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic)]
-> [At CmdErr m Symbolic]
forall a b. (a -> b) -> a -> b
$
    [Maybe Errors
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
-> CmdErr
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. Maybe Errors -> Cmd it -> CmdErr it
CmdErr Maybe Errors
mbErrors' Cmd (IterRef m Symbolic)
Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
cmd  | Maybe Errors
mbErrors' <- Maybe Errors -> [Maybe Errors]
forall a. Arbitrary a => a -> [a]
shrink Maybe Errors
mbErrors] [CmdErr
   (Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Symbolic)]
-> [CmdErr
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic)]
-> [CmdErr
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic)]
forall a. [a] -> [a] -> [a]
++
    [Maybe Errors
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
-> CmdErr
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. Maybe Errors -> Cmd it -> CmdErr it
CmdErr Maybe Errors
mbErrors  Cmd (IterRef m Symbolic)
Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
cmd' | At Cmd (IterRef m Symbolic)
cmd'   <- Model m Symbolic -> At Cmd m Symbolic -> [At Cmd m Symbolic]
forall (m :: * -> *).
Model m Symbolic -> At Cmd m Symbolic -> [At Cmd m Symbolic]
shrinkCmd Model m Symbolic
m (Cmd (IterRef m Symbolic) -> At Cmd m Symbolic
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
t (IterRef m r) -> At t m r
At Cmd (IterRef m Symbolic)
cmd)]

-- | Shrink a 'Cmd'.
shrinkCmd :: Model m Symbolic -> At Cmd m Symbolic -> [At Cmd m Symbolic]
shrinkCmd :: forall (m :: * -> *).
Model m Symbolic -> At Cmd m Symbolic -> [At Cmd m Symbolic]
shrinkCmd Model m Symbolic
_ (At Cmd (IterRef m Symbolic)
cmd) = (Cmd
   (Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Symbolic)
 -> At Cmd m Symbolic)
-> [Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic)]
-> [At Cmd m Symbolic]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Cmd (IterRef m Symbolic) -> At Cmd m Symbolic
Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
-> At Cmd m Symbolic
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
t (IterRef m r) -> At t m r
At ([Cmd
    (Reference
       (Opaque
          (WithEq
             (Iterator
                m
                TestBlock
                (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                 TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                 SomeSecond (NestedCtxt Header) TestBlock))))
       Symbolic)]
 -> [At Cmd m Symbolic])
-> [Cmd
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic)]
-> [At Cmd m Symbolic]
forall a b. (a -> b) -> a -> b
$ case Cmd (IterRef m Symbolic)
cmd of
    Corruption Corruption
corr -> [Corruption
-> Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall it. Corruption -> Cmd it
Corruption Corruption
corr' | Corruption
corr' <- Corruption -> [Corruption]
shrinkCorruption Corruption
corr]
    Cmd (IterRef m Symbolic)
_otherwise      -> []
  where
    shrinkCorruption :: Corruption -> [Corruption]
shrinkCorruption (MkCorruption Corruptions
corrs) =
        [ Corruptions -> Corruption
MkCorruption Corruptions
corrs'
        | Corruptions
corrs' <- Corruptions -> [Corruptions]
shrinkCorruptions Corruptions
corrs
        ]

{-------------------------------------------------------------------------------
  The final state machine
-------------------------------------------------------------------------------}


-- | Mock a response
--
-- We do this by running the pure semantics and then generating mock
-- references for any new handles.
mock :: Typeable m
     => Model           m Symbolic
     -> At CmdErr       m Symbolic
     -> GenSym (At Resp m Symbolic)
mock :: forall (m :: * -> *).
Typeable m =>
Model m Symbolic
-> At CmdErr m Symbolic -> GenSym (At Resp m Symbolic)
mock Model m Symbolic
model At CmdErr m Symbolic
cmdErr = Resp (IterRef m Symbolic) -> At Resp m Symbolic
Resp
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
-> At Resp m Symbolic
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
t (IterRef m r) -> At t m r
At (Resp
   (Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Symbolic)
 -> At Resp m Symbolic)
-> GenSym
     (Resp
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
-> GenSym (At Resp m Symbolic)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int
 -> GenSym
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  m
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Symbolic))
-> Resp Int
-> GenSym
     (Resp
        (Reference
           (Opaque
              (WithEq
                 (Iterator
                    m
                    TestBlock
                    (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                     TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                     SomeSecond (NestedCtxt Header) TestBlock))))
           Symbolic))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Resp a -> f (Resp b)
traverse (GenSym
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
-> Int
-> GenSym
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Symbolic)
forall a b. a -> b -> a
const GenSym
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
forall a. Typeable a => GenSym (Reference a Symbolic)
genSym) Resp Int
resp
  where
    (Resp Int
resp, DBModel TestBlock
_dbm) = Model m Symbolic
-> At CmdErr m Symbolic -> (Resp Int, DBModel TestBlock)
forall (r :: * -> *) (m :: * -> *).
Eq1 r =>
Model m r -> At CmdErr m r -> (Resp Int, DBModel TestBlock)
step Model m Symbolic
model At CmdErr m Symbolic
cmdErr

precondition :: Model m Symbolic -> At CmdErr m Symbolic -> Logic
precondition :: forall (m :: * -> *).
Model m Symbolic -> At CmdErr m Symbolic -> Logic
precondition Model {KnownIters m Symbolic
DBModel TestBlock
dbModel :: forall (m :: * -> *) (r :: * -> *). Model m r -> DBModel TestBlock
knownIters :: forall (m :: * -> *) (r :: * -> *). Model m r -> KnownIters m r
dbModel :: DBModel TestBlock
knownIters :: KnownIters m Symbolic
..} (At (CmdErr { Cmd (IterRef m Symbolic)
cmd :: forall it. CmdErr it -> Cmd it
cmd :: Cmd (IterRef m Symbolic)
cmd })) =
   [Reference
   (Opaque
      (WithEq
         (Iterator
            m
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
   Symbolic]
-> (Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Symbolic
    -> Logic)
-> Logic
forall a. Show a => [a] -> (a -> Logic) -> Logic
forAll (Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
-> [Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Symbolic]
forall (t :: * -> *) it. Traversable t => t it -> [it]
iters Cmd (IterRef m Symbolic)
Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
cmd) (Reference
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Symbolic
-> [Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Symbolic]
-> Logic
forall (t :: * -> *) a.
(Foldable t, Eq a, Show a, Show (t a)) =>
a -> t a -> Logic
`member` RefEnv
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Int
  Symbolic
-> [Reference
      (Opaque
         (WithEq
            (Iterator
               m
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Symbolic]
forall k a (r :: * -> *). RefEnv k a r -> [Reference k r]
RE.keys KnownIters m Symbolic
RefEnv
  (Opaque
     (WithEq
        (Iterator
           m
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Int
  Symbolic
knownIters) Logic -> Logic -> Logic
.&&
    case Cmd (IterRef m Symbolic)
cmd of
      AppendBlock TestBlock
blk -> TestBlock -> Logic
fitsOnTip TestBlock
blk
      DeleteAfter WithOrigin (Tip TestBlock)
tip -> WithOrigin (Tip TestBlock)
tip WithOrigin (Tip TestBlock) -> [WithOrigin (Tip TestBlock)] -> Logic
forall (t :: * -> *) a.
(Foldable t, Eq a, Show a, Show (t a)) =>
a -> t a -> Logic
`member` NonEmpty (WithOrigin (Tip TestBlock))
-> [WithOrigin (Tip TestBlock)]
forall a. NonEmpty a -> [a]
NE.toList (DBModel TestBlock -> NonEmpty (WithOrigin (Tip TestBlock))
forall blk.
GetHeader blk =>
DBModel blk -> NonEmpty (WithOrigin (Tip blk))
tips DBModel TestBlock
dbModel)
      Corruption Corruption
corr ->
        [FsPath] -> (FsPath -> Logic) -> Logic
forall a. Show a => [a] -> (a -> Logic) -> Logic
forAll
          (Corruptions -> [FsPath]
corruptionFiles (Corruption -> Corruptions
getCorruptions Corruption
corr))
          (FsPath -> [FsPath] -> Logic
forall (t :: * -> *) a.
(Foldable t, Eq a, Show a, Show (t a)) =>
a -> t a -> Logic
`member` DBModel TestBlock -> [FsPath]
getDBFiles DBModel TestBlock
dbModel)
      Cmd (IterRef m Symbolic)
_ -> Logic
Top
  where
    fitsOnTip :: TestBlock -> Logic
    fitsOnTip :: TestBlock -> Logic
fitsOnTip TestBlock
b = case DBModel TestBlock -> WithOrigin TestBlock
forall blk. DBModel blk -> WithOrigin blk
dbmTipBlock DBModel TestBlock
dbModel of
      WithOrigin TestBlock
Origin          -> TestBlock -> ChainHash TestBlock
forall blk. GetPrevHash blk => blk -> ChainHash blk
blockPrevHash TestBlock
b ChainHash TestBlock -> ChainHash TestBlock -> Logic
forall a. (Eq a, Show a) => a -> a -> Logic
.== ChainHash TestBlock
forall {k} (b :: k). ChainHash b
GenesisHash
      NotOrigin TestBlock
bPrev -> TestBlock -> ChainHash TestBlock
forall blk. GetPrevHash blk => blk -> ChainHash blk
blockPrevHash TestBlock
b ChainHash TestBlock -> ChainHash TestBlock -> Logic
forall a. (Eq a, Show a) => a -> a -> Logic
.== HeaderHash TestBlock -> ChainHash TestBlock
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash (TestBlock -> HeaderHash TestBlock
forall b. HasHeader b => b -> HeaderHash b
blockHash TestBlock
bPrev)

transition :: (Show1 r, Eq1 r)
           => Model m r -> At CmdErr m r -> At Resp m r -> Model m r
transition :: forall (r :: * -> *) (m :: * -> *).
(Show1 r, Eq1 r) =>
Model m r -> At CmdErr m r -> At Resp m r -> Model m r
transition Model m r
model At CmdErr m r
cmdErr = Event m r -> Model m r
forall (m :: * -> *) (r :: * -> *). Event m r -> Model m r
eventAfter (Event m r -> Model m r)
-> (At Resp m r -> Event m r) -> At Resp m r -> Model m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model m r -> At CmdErr m r -> At Resp m r -> Event m r
forall (r :: * -> *) (m :: * -> *).
(Show1 r, Eq1 r) =>
Model m r -> At CmdErr m r -> At Resp m r -> Event m r
lockstep Model m r
model At CmdErr m r
cmdErr

postcondition :: Model m Concrete
              -> At CmdErr m Concrete
              -> At Resp m Concrete
              -> Logic
postcondition :: forall (m :: * -> *).
Model m Concrete
-> At CmdErr m Concrete -> At Resp m Concrete -> Logic
postcondition Model m Concrete
model At CmdErr m Concrete
cmdErr At Resp m Concrete
resp =
    Model m Concrete -> At Resp m Concrete -> Resp Int
forall (t :: * -> *) (r :: * -> *) (m :: * -> *).
(Functor t, Eq1 r) =>
Model m r -> At t m r -> t Int
toMock (Event m Concrete -> Model m Concrete
forall (m :: * -> *) (r :: * -> *). Event m r -> Model m r
eventAfter Event m Concrete
ev) At Resp m Concrete
resp Resp Int -> Resp Int -> Logic
forall a. (Eq a, Show a) => a -> a -> Logic
.== Event m Concrete -> Resp Int
forall (m :: * -> *) (r :: * -> *). Event m r -> Resp Int
eventMockResp Event m Concrete
ev
  where
    ev :: Event m Concrete
ev = Model m Concrete
-> At CmdErr m Concrete -> At Resp m Concrete -> Event m Concrete
forall (r :: * -> *) (m :: * -> *).
(Show1 r, Eq1 r) =>
Model m r -> At CmdErr m r -> At Resp m r -> Event m r
lockstep Model m Concrete
model At CmdErr m Concrete
cmdErr At Resp m Concrete
resp

data ImmutableDBState = ImmutableDBState {
      ImmutableDBState -> ImmutableDB IO TestBlock
db       :: ImmutableDB          IO TestBlock
    , ImmutableDBState -> Internal IO TestBlock
internal :: ImmutableDB.Internal IO TestBlock
    }
  deriving [String] -> ImmutableDBState -> IO (Maybe ThunkInfo)
Proxy ImmutableDBState -> String
([String] -> ImmutableDBState -> IO (Maybe ThunkInfo))
-> ([String] -> ImmutableDBState -> IO (Maybe ThunkInfo))
-> (Proxy ImmutableDBState -> String)
-> NoThunks ImmutableDBState
forall a.
([String] -> a -> IO (Maybe ThunkInfo))
-> ([String] -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: [String] -> ImmutableDBState -> IO (Maybe ThunkInfo)
noThunks :: [String] -> ImmutableDBState -> IO (Maybe ThunkInfo)
$cwNoThunks :: [String] -> ImmutableDBState -> IO (Maybe ThunkInfo)
wNoThunks :: [String] -> ImmutableDBState -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy ImmutableDBState -> String
showTypeOf :: Proxy ImmutableDBState -> String
NoThunks via AllowThunk ImmutableDBState

-- | Environment to run commands against the real ImmutableDB implementation.
data ImmutableDBEnv = ImmutableDBEnv {
      ImmutableDBEnv -> StrictTVar IO Errors
varErrors :: StrictTVar IO Errors
    , ImmutableDBEnv -> StrictTVar IO Id
varNextId :: StrictTVar IO Id
    , ImmutableDBEnv -> StrictTVar IO [TestIterator IO]
varIters  :: StrictTVar IO [TestIterator IO]
      -- ^ A list of all open iterators. For some commands, e.g., corrupting the
      -- database or simulating errors, we need to close and reopen the
      -- database, which almost always requires truncation of the database.
      -- During truncation we might need to delete a file that is still opened
      -- by an iterator. As this is not allowed by the MockFS implementation, we
      -- first close all open iterators in these cases.
    , ImmutableDBEnv -> StrictTVar IO ImmutableDBState
varDB     :: StrictTVar IO ImmutableDBState
    , ImmutableDBEnv -> ImmutableDbArgs Identity IO TestBlock
args      :: ImmutableDbArgs Identity IO TestBlock
    }

getImmutableDB :: ImmutableDBEnv -> IO (ImmutableDB IO TestBlock)
getImmutableDB :: ImmutableDBEnv -> IO (ImmutableDB IO TestBlock)
getImmutableDB = (ImmutableDBState -> ImmutableDB IO TestBlock)
-> IO ImmutableDBState -> IO (ImmutableDB IO TestBlock)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImmutableDBState -> ImmutableDB IO TestBlock
db (IO ImmutableDBState -> IO (ImmutableDB IO TestBlock))
-> (ImmutableDBEnv -> IO ImmutableDBState)
-> ImmutableDBEnv
-> IO (ImmutableDB IO TestBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictTVar IO ImmutableDBState -> IO ImmutableDBState
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO (StrictTVar IO ImmutableDBState -> IO ImmutableDBState)
-> (ImmutableDBEnv -> StrictTVar IO ImmutableDBState)
-> ImmutableDBEnv
-> IO ImmutableDBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImmutableDBEnv -> StrictTVar IO ImmutableDBState
varDB

getInternal :: ImmutableDBEnv -> IO (ImmutableDB.Internal IO TestBlock)
getInternal :: ImmutableDBEnv -> IO (Internal IO TestBlock)
getInternal = (ImmutableDBState -> Internal IO TestBlock)
-> IO ImmutableDBState -> IO (Internal IO TestBlock)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ImmutableDBState -> Internal IO TestBlock
internal (IO ImmutableDBState -> IO (Internal IO TestBlock))
-> (ImmutableDBEnv -> IO ImmutableDBState)
-> ImmutableDBEnv
-> IO (Internal IO TestBlock)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictTVar IO ImmutableDBState -> IO ImmutableDBState
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO (StrictTVar IO ImmutableDBState -> IO ImmutableDBState)
-> (ImmutableDBEnv -> StrictTVar IO ImmutableDBState)
-> ImmutableDBEnv
-> IO ImmutableDBState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImmutableDBEnv -> StrictTVar IO ImmutableDBState
varDB

semantics ::
     ImmutableDBEnv
  -> At CmdErr IO Concrete
  -> IO (At Resp IO Concrete)
semantics :: ImmutableDBEnv -> At CmdErr IO Concrete -> IO (At Resp IO Concrete)
semantics env :: ImmutableDBEnv
env@ImmutableDBEnv {StrictTVar IO [TestIterator IO]
StrictTVar IO Errors
StrictTVar IO Id
StrictTVar IO ImmutableDBState
ImmutableDbArgs Identity IO TestBlock
varDB :: ImmutableDBEnv -> StrictTVar IO ImmutableDBState
args :: ImmutableDBEnv -> ImmutableDbArgs Identity IO TestBlock
varNextId :: ImmutableDBEnv -> StrictTVar IO Id
varIters :: ImmutableDBEnv -> StrictTVar IO [TestIterator IO]
varErrors :: ImmutableDBEnv -> StrictTVar IO Errors
varErrors :: StrictTVar IO Errors
varNextId :: StrictTVar IO Id
varIters :: StrictTVar IO [TestIterator IO]
varDB :: StrictTVar IO ImmutableDBState
args :: ImmutableDbArgs Identity IO TestBlock
..} (At CmdErr (IterRef IO Concrete)
cmdErr) =
    Resp (IterRef IO Concrete) -> At Resp IO Concrete
Resp
  (Reference
     (Opaque
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Concrete)
-> At Resp IO Concrete
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
t (IterRef m r) -> At t m r
At (Resp
   (Reference
      (Opaque
         (WithEq
            (Iterator
               IO
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Concrete)
 -> At Resp IO Concrete)
-> (Either
      (ImmutableDBError TestBlock)
      (Success
         (WithEq
            (Iterator
               IO
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
    -> Resp
         (Reference
            (Opaque
               (WithEq
                  (Iterator
                     IO
                     TestBlock
                     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                      SomeSecond (NestedCtxt Header) TestBlock))))
            Concrete))
-> Either
     (ImmutableDBError TestBlock)
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
-> At Resp IO Concrete
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WithEq
   (Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock))
 -> Reference
      (Opaque
         (WithEq
            (Iterator
               IO
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Concrete)
-> Resp
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
-> Resp
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Concrete)
forall a b. (a -> b) -> Resp a -> Resp b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Opaque
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
-> Reference
     (Opaque
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Concrete
forall a. Typeable a => a -> Reference a Concrete
reference (Opaque
   (WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock)))
 -> Reference
      (Opaque
         (WithEq
            (Iterator
               IO
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
      Concrete)
-> (WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock))
    -> Opaque
         (WithEq
            (Iterator
               IO
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
-> WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))
-> Reference
     (Opaque
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Concrete
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithEq
  (Iterator
     IO
     TestBlock
     (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
      TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
      SomeSecond (NestedCtxt Header) TestBlock))
-> Opaque
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall a. a -> Opaque a
Opaque) (Resp
   (WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock)))
 -> Resp
      (Reference
         (Opaque
            (WithEq
               (Iterator
                  IO
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))
         Concrete))
-> (Either
      (ImmutableDBError TestBlock)
      (Success
         (WithEq
            (Iterator
               IO
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
    -> Resp
         (WithEq
            (Iterator
               IO
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock))))
-> Either
     (ImmutableDBError TestBlock)
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
-> Resp
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Concrete)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either
  (ImmutableDBError TestBlock)
  (Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
-> Resp
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it.
Either (ImmutableDBError TestBlock) (Success it) -> Resp it
Resp (Either
   (ImmutableDBError TestBlock)
   (Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
 -> At Resp IO Concrete)
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
-> IO (At Resp IO Concrete)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Reference
  (Opaque
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
  Concrete
-> WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))
forall a. Reference (Opaque a) Concrete -> a
opaque (Reference
   (Opaque
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
   Concrete
 -> WithEq
      (Iterator
         IO
         TestBlock
         (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
          TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
          SomeSecond (NestedCtxt Header) TestBlock)))
-> CmdErr
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        Concrete)
-> CmdErr
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmdErr (IterRef IO Concrete)
CmdErr
  (Reference
     (Opaque
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Concrete)
cmdErr of

      CmdErr Maybe Errors
Nothing       Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
cmd -> Proxy TestBlock
-> IO (Success (TestIterator IO))
-> IO
     (Either (ImmutableDBError TestBlock) (Success (TestIterator IO)))
forall (m :: * -> *) blk a.
(MonadCatch m, StandardHash blk, Typeable blk) =>
Proxy blk -> m a -> m (Either (ImmutableDBError blk) a)
tryImmutableDB (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @TestBlock) (IO (Success (TestIterator IO))
 -> IO
      (Either (ImmutableDBError TestBlock) (Success (TestIterator IO))))
-> IO (Success (TestIterator IO))
-> IO
     (Either (ImmutableDBError TestBlock) (Success (TestIterator IO)))
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ImmutableDBEnv
-> Cmd (TestIterator IO) -> IO (Success (TestIterator IO))
ImmutableDBEnv
-> Cmd (TestIterator IO) -> IO (Success (TestIterator IO))
run ImmutableDBEnv
env Cmd (TestIterator IO)
Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
cmd

      CmdErr (Just Errors
errors) Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
cmd -> do
        WithOrigin (Tip TestBlock)
tipBefore <- ImmutableDBEnv -> IO (ImmutableDB IO TestBlock)
getImmutableDB ImmutableDBEnv
env IO (ImmutableDB IO TestBlock)
-> (ImmutableDB IO TestBlock -> IO (WithOrigin (Tip TestBlock)))
-> IO (WithOrigin (Tip TestBlock))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM (WithOrigin (Tip TestBlock)) -> IO (WithOrigin (Tip TestBlock))
STM IO (WithOrigin (Tip TestBlock))
-> IO (WithOrigin (Tip TestBlock))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (WithOrigin (Tip TestBlock))
 -> IO (WithOrigin (Tip TestBlock)))
-> (ImmutableDB IO TestBlock -> STM (WithOrigin (Tip TestBlock)))
-> ImmutableDB IO TestBlock
-> IO (WithOrigin (Tip TestBlock))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImmutableDB IO TestBlock -> STM (WithOrigin (Tip TestBlock))
ImmutableDB IO TestBlock -> STM IO (WithOrigin (Tip TestBlock))
forall (m :: * -> *) blk.
HasCallStack =>
ImmutableDB m blk -> STM m (WithOrigin (Tip blk))
getTip
        Either
  (ImmutableDBError TestBlock)
  (Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
res       <- StrictTVar IO Errors
-> Errors
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
forall (m :: * -> *) a.
MonadSTM m =>
StrictTVar m Errors -> Errors -> m a -> m a
withErrors (StrictTVar IO Errors -> StrictTVar IO Errors
forall (m :: * -> *) a. StrictTVar m a -> StrictTVar m a
unsafeToUncheckedStrictTVar StrictTVar IO Errors
varErrors) Errors
errors (IO
   (Either
      (ImmutableDBError TestBlock)
      (Success
         (WithEq
            (Iterator
               IO
               TestBlock
               (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                SomeSecond (NestedCtxt Header) TestBlock)))))
 -> IO
      (Either
         (ImmutableDBError TestBlock)
         (Success
            (WithEq
               (Iterator
                  IO
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))))
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
forall a b. (a -> b) -> a -> b
$
                       Proxy TestBlock
-> IO (Success (TestIterator IO))
-> IO
     (Either (ImmutableDBError TestBlock) (Success (TestIterator IO)))
forall (m :: * -> *) blk a.
(MonadCatch m, StandardHash blk, Typeable blk) =>
Proxy blk -> m a -> m (Either (ImmutableDBError blk) a)
tryImmutableDB (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @TestBlock) (IO (Success (TestIterator IO))
 -> IO
      (Either (ImmutableDBError TestBlock) (Success (TestIterator IO))))
-> IO (Success (TestIterator IO))
-> IO
     (Either (ImmutableDBError TestBlock) (Success (TestIterator IO)))
forall a b. (a -> b) -> a -> b
$ HasCallStack =>
ImmutableDBEnv
-> Cmd (TestIterator IO) -> IO (Success (TestIterator IO))
ImmutableDBEnv
-> Cmd (TestIterator IO) -> IO (Success (TestIterator IO))
run ImmutableDBEnv
env Cmd (TestIterator IO)
Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
cmd
        case Either
  (ImmutableDBError TestBlock)
  (Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock))))
res of
          -- If the command resulted in a 'ApiMisuse', we didn't even get the
          -- chance to run into a simulated error. Note that we still
          -- truncate, because we can't predict whether we'll get a
          -- 'ApiMisuse' or an 'UnexpectedFailure', as it depends on the
          -- simulated error.
          Left (ApiMisuse {})       ->
            Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
-> WithOrigin (Tip TestBlock)
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
truncateAndReopen Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
cmd WithOrigin (Tip TestBlock)
tipBefore

          -- We encountered a simulated error
          Left (UnexpectedFailure {}) ->
            Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
-> WithOrigin (Tip TestBlock)
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
truncateAndReopen Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
cmd WithOrigin (Tip TestBlock)
tipBefore

          -- TODO track somewhere which/how many errors were *actually* thrown

          -- By coincidence no error was thrown, try to mimic what would have
          -- happened if the error was thrown, so that we stay in sync with
          -- the model.
          Right Success
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
_suc                 ->
            Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
-> WithOrigin (Tip TestBlock)
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
truncateAndReopen Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
cmd WithOrigin (Tip TestBlock)
tipBefore
            -- Note that we might have created an iterator, make sure to close
            -- it as well
  where
    ImmutableDbArgs { HKD Identity (ResourceRegistry IO)
immRegistry :: forall (f :: * -> *) (m :: * -> *) blk.
ImmutableDbArgs f m blk -> HKD f (ResourceRegistry m)
immRegistry :: HKD Identity (ResourceRegistry IO)
immRegistry } = ImmutableDbArgs Identity IO TestBlock
args

    truncateAndReopen :: Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
-> WithOrigin (Tip TestBlock)
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
truncateAndReopen Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
cmd WithOrigin (Tip TestBlock)
tipBefore = Proxy TestBlock
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
forall (m :: * -> *) blk a.
(MonadCatch m, StandardHash blk, Typeable blk) =>
Proxy blk -> m a -> m (Either (ImmutableDBError blk) a)
tryImmutableDB (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @TestBlock) (IO
   (Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
 -> IO
      (Either
         (ImmutableDBError TestBlock)
         (Success
            (WithEq
               (Iterator
                  IO
                  TestBlock
                  (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                   TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                   SomeSecond (NestedCtxt Header) TestBlock))))))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
-> IO
     (Either
        (ImmutableDBError TestBlock)
        (Success
           (WithEq
              (Iterator
                 IO
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock)))))
forall a b. (a -> b) -> a -> b
$ do
      -- Close all open iterators as we will perform truncation
      StrictTVar IO [TestIterator IO] -> IO ()
closeOpenIterators StrictTVar IO [TestIterator IO]
varIters
      -- Close the database in case no errors occurred and it wasn't
      -- closed already. This is idempotent anyway.
      ImmutableDBEnv -> IO (ImmutableDB IO TestBlock)
getImmutableDB ImmutableDBEnv
env IO (ImmutableDB IO TestBlock)
-> (ImmutableDB IO TestBlock -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ImmutableDB IO TestBlock -> IO ()
forall (m :: * -> *) blk. HasCallStack => ImmutableDB m blk -> m ()
closeDB
      -- Release any handles that weren't closed because of a simulated error.
      ResourceRegistry IO -> IO ()
forall (m :: * -> *).
(MonadMask m, MonadSTM m, MonadThread m, HasCallStack) =>
ResourceRegistry m -> m ()
releaseAll HKD Identity (ResourceRegistry IO)
ResourceRegistry IO
immRegistry
      ImmutableDBEnv -> ValidationPolicy -> IO ()
reopen ImmutableDBEnv
env ValidationPolicy
ValidateAllChunks
      ImmutableDBEnv -> IO (Internal IO TestBlock)
getInternal ImmutableDBEnv
env IO (Internal IO TestBlock)
-> (Internal IO TestBlock -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Internal IO TestBlock -> WithOrigin (Tip TestBlock) -> IO ())
-> WithOrigin (Tip TestBlock) -> Internal IO TestBlock -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Internal IO TestBlock -> WithOrigin (Tip TestBlock) -> IO ()
forall (m :: * -> *) blk.
HasCallStack =>
Internal m blk -> WithOrigin (Tip blk) -> m ()
deleteAfter WithOrigin (Tip TestBlock)
tipBefore
      -- If the cmd deleted things, we must do it here to have a deterministic
      -- outcome and to stay in sync with the model. If no error was thrown,
      -- these things will have been deleted. If an error was thrown, they
      -- might not have been deleted or only part of them.
      case Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
cmd of
        DeleteAfter WithOrigin (Tip TestBlock)
tip -> ImmutableDBEnv -> IO (Internal IO TestBlock)
getInternal ImmutableDBEnv
env IO (Internal IO TestBlock)
-> (Internal IO TestBlock -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Internal IO TestBlock -> WithOrigin (Tip TestBlock) -> IO ())
-> WithOrigin (Tip TestBlock) -> Internal IO TestBlock -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Internal IO TestBlock -> WithOrigin (Tip TestBlock) -> IO ()
forall (m :: * -> *) blk.
HasCallStack =>
Internal m blk -> WithOrigin (Tip blk) -> m ()
deleteAfter WithOrigin (Tip TestBlock)
tip
        Cmd
  (WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock)))
_               -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      WithOrigin (Tip TestBlock)
-> Success
     (WithEq
        (Iterator
           IO
           TestBlock
           (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
            TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
            SomeSecond (NestedCtxt Header) TestBlock)))
forall it. WithOrigin (Tip TestBlock) -> Success it
ImmTip (WithOrigin (Tip TestBlock)
 -> Success
      (WithEq
         (Iterator
            IO
            TestBlock
            (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
             TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
             SomeSecond (NestedCtxt Header) TestBlock))))
-> IO (WithOrigin (Tip TestBlock))
-> IO
     (Success
        (WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ImmutableDBEnv -> IO (ImmutableDB IO TestBlock)
getImmutableDB ImmutableDBEnv
env IO (ImmutableDB IO TestBlock)
-> (ImmutableDB IO TestBlock -> IO (WithOrigin (Tip TestBlock)))
-> IO (WithOrigin (Tip TestBlock))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM (WithOrigin (Tip TestBlock)) -> IO (WithOrigin (Tip TestBlock))
STM IO (WithOrigin (Tip TestBlock))
-> IO (WithOrigin (Tip TestBlock))
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM (WithOrigin (Tip TestBlock))
 -> IO (WithOrigin (Tip TestBlock)))
-> (ImmutableDB IO TestBlock -> STM (WithOrigin (Tip TestBlock)))
-> ImmutableDB IO TestBlock
-> IO (WithOrigin (Tip TestBlock))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImmutableDB IO TestBlock -> STM (WithOrigin (Tip TestBlock))
ImmutableDB IO TestBlock -> STM IO (WithOrigin (Tip TestBlock))
forall (m :: * -> *) blk.
HasCallStack =>
ImmutableDB m blk -> STM m (WithOrigin (Tip blk))
getTip)

-- | The state machine proper
sm ::
     ImmutableDBEnv
  -> DBModel TestBlock
  -> StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
sm :: ImmutableDBEnv
-> DBModel TestBlock
-> StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
sm ImmutableDBEnv
env DBModel TestBlock
dbm = StateMachine {
      initModel :: forall (r :: * -> *). Model IO r
initModel     = DBModel TestBlock -> Model IO r
forall (m :: * -> *) (r :: * -> *). DBModel TestBlock -> Model m r
initModel DBModel TestBlock
dbm
    , transition :: forall (r :: * -> *).
(Show1 r, Ord1 r) =>
Model IO r -> At CmdErr IO r -> At Resp IO r -> Model IO r
transition    = Model IO r -> At CmdErr IO r -> At Resp IO r -> Model IO r
forall (r :: * -> *).
(Show1 r, Ord1 r) =>
Model IO r -> At CmdErr IO r -> At Resp IO r -> Model IO r
forall (r :: * -> *) (m :: * -> *).
(Show1 r, Eq1 r) =>
Model m r -> At CmdErr m r -> At Resp m r -> Model m r
transition
    , precondition :: Model IO Symbolic -> At CmdErr IO Symbolic -> Logic
precondition  = Model IO Symbolic -> At CmdErr IO Symbolic -> Logic
forall (m :: * -> *).
Model m Symbolic -> At CmdErr m Symbolic -> Logic
precondition
    , postcondition :: Model IO Concrete
-> At CmdErr IO Concrete -> At Resp IO Concrete -> Logic
postcondition = Model IO Concrete
-> At CmdErr IO Concrete -> At Resp IO Concrete -> Logic
forall (m :: * -> *).
Model m Concrete
-> At CmdErr m Concrete -> At Resp m Concrete -> Logic
postcondition
    , generator :: Model IO Symbolic -> Maybe (Gen (At CmdErr IO Symbolic))
generator     = Gen (At CmdErr IO Symbolic) -> Maybe (Gen (At CmdErr IO Symbolic))
forall a. a -> Maybe a
Just (Gen (At CmdErr IO Symbolic)
 -> Maybe (Gen (At CmdErr IO Symbolic)))
-> (Model IO Symbolic -> Gen (At CmdErr IO Symbolic))
-> Model IO Symbolic
-> Maybe (Gen (At CmdErr IO Symbolic))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model IO Symbolic -> Gen (At CmdErr IO Symbolic)
forall (m :: * -> *).
Model m Symbolic -> Gen (At CmdErr m Symbolic)
generator
    , shrinker :: Model IO Symbolic
-> At CmdErr IO Symbolic -> [At CmdErr IO Symbolic]
shrinker      = Model IO Symbolic
-> At CmdErr IO Symbolic -> [At CmdErr IO Symbolic]
forall (m :: * -> *).
Model m Symbolic -> At CmdErr m Symbolic -> [At CmdErr m Symbolic]
shrinker
    , semantics :: At CmdErr IO Concrete -> IO (At Resp IO Concrete)
semantics     = ImmutableDBEnv -> At CmdErr IO Concrete -> IO (At Resp IO Concrete)
semantics ImmutableDBEnv
env
    , mock :: Model IO Symbolic
-> At CmdErr IO Symbolic -> GenSym (At Resp IO Symbolic)
mock          = Model IO Symbolic
-> At CmdErr IO Symbolic -> GenSym (At Resp IO Symbolic)
forall (m :: * -> *).
Typeable m =>
Model m Symbolic
-> At CmdErr m Symbolic -> GenSym (At Resp m Symbolic)
mock
    , invariant :: Maybe (Model IO Concrete -> Logic)
invariant     = Maybe (Model IO Concrete -> Logic)
forall a. Maybe a
Nothing
    , cleanup :: Model IO Concrete -> IO ()
cleanup       = Model IO Concrete -> IO ()
forall (m :: * -> *) (model :: (* -> *) -> *).
Monad m =>
model Concrete -> m ()
noCleanup
    }

{-------------------------------------------------------------------------------
  Labelling
-------------------------------------------------------------------------------}

data Tag =
    TagGetBlockComponentFound

  | TagGetBlockComponentFoundEBB

  | TagGetBlockComponentEmptySlot

  | TagGetBlockComponentWrongHash

  | TagGetBlockComponentNewerThanTip

  | TagAppendBlockNotNewerThanTipError

  | TagInvalidIteratorRangeError

  | TagIteratorStreamedN Int

  | TagCorruption

  | TagMigrate

  | TagErrorDuringAppendBlock

  | TagErrorDuringGetBlockComponent

  | TagErrorDuringStream

  | TagErrorDuringIteratorNext

  | TagErrorDuringIteratorClose

  | TagGetHashForSlot Bool

  deriving (Int -> Tag -> ShowS
[Tag] -> ShowS
Tag -> String
(Int -> Tag -> ShowS)
-> (Tag -> String) -> ([Tag] -> ShowS) -> Show Tag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Tag -> ShowS
showsPrec :: Int -> Tag -> ShowS
$cshow :: Tag -> String
show :: Tag -> String
$cshowList :: [Tag] -> ShowS
showList :: [Tag] -> ShowS
Show, Tag -> Tag -> Bool
(Tag -> Tag -> Bool) -> (Tag -> Tag -> Bool) -> Eq Tag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tag -> Tag -> Bool
== :: Tag -> Tag -> Bool
$c/= :: Tag -> Tag -> Bool
/= :: Tag -> Tag -> Bool
Eq)


-- | Predicate on events
type EventPred m = C.Predicate (Event m Symbolic) Tag

-- | Convenience combinator for creating classifiers for successful commands
successful :: (    Event m Symbolic
                -> Success IteratorId
                -> Either Tag (EventPred m)
              )
           -> EventPred m
successful :: forall (m :: * -> *).
(Event m Symbolic -> Success Int -> Either Tag (EventPred m))
-> EventPred m
successful Event m Symbolic -> Success Int -> Either Tag (EventPred m)
f = (Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m
forall a b. (a -> Either b (Predicate a b)) -> Predicate a b
C.predicate ((Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m)
-> (Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
ev -> case Event m Symbolic -> Resp Int
forall (m :: * -> *) (r :: * -> *). Event m r -> Resp Int
eventMockResp Event m Symbolic
ev of
    Resp (Left  ImmutableDBError TestBlock
_ ) -> EventPred m -> Either Tag (EventPred m)
forall a b. b -> Either a b
Right (EventPred m -> Either Tag (EventPred m))
-> EventPred m -> Either Tag (EventPred m)
forall a b. (a -> b) -> a -> b
$ (Event m Symbolic -> Success Int -> Either Tag (EventPred m))
-> EventPred m
forall (m :: * -> *).
(Event m Symbolic -> Success Int -> Either Tag (EventPred m))
-> EventPred m
successful Event m Symbolic -> Success Int -> Either Tag (EventPred m)
f
    Resp (Right Success Int
ok) -> Event m Symbolic -> Success Int -> Either Tag (EventPred m)
f Event m Symbolic
ev Success Int
ok

-- | Convenience combinator for creating classifiers for failed commands
failed :: (    Event m Symbolic
            -> ImmutableDBError TestBlock
            -> Either Tag (EventPred m)
          )
       -> EventPred m
failed :: forall (m :: * -> *).
(Event m Symbolic
 -> ImmutableDBError TestBlock -> Either Tag (EventPred m))
-> EventPred m
failed Event m Symbolic
-> ImmutableDBError TestBlock -> Either Tag (EventPred m)
f = (Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m
forall a b. (a -> Either b (Predicate a b)) -> Predicate a b
C.predicate ((Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m)
-> (Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
ev -> case Event m Symbolic -> Resp Int
forall (m :: * -> *) (r :: * -> *). Event m r -> Resp Int
eventMockResp Event m Symbolic
ev of
    Resp (Left  ImmutableDBError TestBlock
e) -> Event m Symbolic
-> ImmutableDBError TestBlock -> Either Tag (EventPred m)
f Event m Symbolic
ev ImmutableDBError TestBlock
e
    Resp (Right Success Int
_) -> EventPred m -> Either Tag (EventPred m)
forall a b. b -> Either a b
Right (EventPred m -> Either Tag (EventPred m))
-> EventPred m -> Either Tag (EventPred m)
forall a b. (a -> b) -> a -> b
$ (Event m Symbolic
 -> ImmutableDBError TestBlock -> Either Tag (EventPred m))
-> EventPred m
forall (m :: * -> *).
(Event m Symbolic
 -> ImmutableDBError TestBlock -> Either Tag (EventPred m))
-> EventPred m
failed Event m Symbolic
-> ImmutableDBError TestBlock -> Either Tag (EventPred m)
f

-- | Convenience combinator for creating classifiers for commands failed with
-- a @ApiMisuse@.
failedApiMisuse :: (    Event m Symbolic
                     -> ApiMisuse TestBlock
                     -> Either Tag (EventPred m)
                   )
                -> EventPred m
failedApiMisuse :: forall (m :: * -> *).
(Event m Symbolic
 -> ApiMisuse TestBlock -> Either Tag (EventPred m))
-> EventPred m
failedApiMisuse Event m Symbolic -> ApiMisuse TestBlock -> Either Tag (EventPred m)
f = (Event m Symbolic
 -> ImmutableDBError TestBlock -> Either Tag (EventPred m))
-> EventPred m
forall (m :: * -> *).
(Event m Symbolic
 -> ImmutableDBError TestBlock -> Either Tag (EventPred m))
-> EventPred m
failed ((Event m Symbolic
  -> ImmutableDBError TestBlock -> Either Tag (EventPred m))
 -> EventPred m)
-> (Event m Symbolic
    -> ImmutableDBError TestBlock -> Either Tag (EventPred m))
-> EventPred m
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
ev ImmutableDBError TestBlock
e -> case ImmutableDBError TestBlock
e of
    ApiMisuse ApiMisuse TestBlock
am PrettyCallStack
_ -> Event m Symbolic -> ApiMisuse TestBlock -> Either Tag (EventPred m)
f Event m Symbolic
ev ApiMisuse TestBlock
am
    ImmutableDBError TestBlock
_              -> EventPred m -> Either Tag (EventPred m)
forall a b. b -> Either a b
Right (EventPred m -> Either Tag (EventPred m))
-> EventPred m -> Either Tag (EventPred m)
forall a b. (a -> b) -> a -> b
$ (Event m Symbolic
 -> ApiMisuse TestBlock -> Either Tag (EventPred m))
-> EventPred m
forall (m :: * -> *).
(Event m Symbolic
 -> ApiMisuse TestBlock -> Either Tag (EventPred m))
-> EventPred m
failedApiMisuse Event m Symbolic -> ApiMisuse TestBlock -> Either Tag (EventPred m)
f

-- | Convenience combinator for creating classifiers for commands for which an
-- error is simulated.
simulatedError :: (Event m Symbolic -> Either Tag (EventPred m))
               -> EventPred m
simulatedError :: forall (m :: * -> *).
(Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m
simulatedError Event m Symbolic -> Either Tag (EventPred m)
f = (Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m
forall a b. (a -> Either b (Predicate a b)) -> Predicate a b
C.predicate ((Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m)
-> (Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
ev ->
    case (CmdErr
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     Symbolic)
-> Maybe Errors
forall it. CmdErr it -> Maybe Errors
cmdErr (At CmdErr m Symbolic -> CmdErr (IterRef m Symbolic)
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
At t m r -> t (IterRef m r)
unAt (Event m Symbolic -> At CmdErr m Symbolic
forall (m :: * -> *) (r :: * -> *). Event m r -> At CmdErr m r
eventCmdErr Event m Symbolic
ev)), Resp Int -> Either (ImmutableDBError TestBlock) (Success Int)
forall it.
Resp it -> Either (ImmutableDBError TestBlock) (Success it)
getResp (Event m Symbolic -> Resp Int
forall (m :: * -> *) (r :: * -> *). Event m r -> Resp Int
eventMockResp Event m Symbolic
ev)) of
      (Just Errors
_, Right Success Int
_) -> Event m Symbolic -> Either Tag (EventPred m)
f Event m Symbolic
ev
      (Maybe Errors, Either (ImmutableDBError TestBlock) (Success Int))
_                 -> EventPred m -> Either Tag (EventPred m)
forall a b. b -> Either a b
Right (EventPred m -> Either Tag (EventPred m))
-> EventPred m -> Either Tag (EventPred m)
forall a b. (a -> b) -> a -> b
$ (Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m
forall (m :: * -> *).
(Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m
simulatedError Event m Symbolic -> Either Tag (EventPred m)
f


-- | Tag commands
--
-- Tagging works on symbolic events, so that we can tag without doing real IO.
tag :: forall m. [Event m Symbolic] -> [Tag]
tag :: forall (m :: * -> *). [Event m Symbolic] -> [Tag]
tag = [Predicate (Event m Symbolic) Tag] -> [Event m Symbolic] -> [Tag]
forall a b. [Predicate a b] -> [a] -> [b]
C.classify
    [ Predicate (Event m Symbolic) Tag
tagGetBlockComponentFound
    , Predicate (Event m Symbolic) Tag
tagGetBlockComponentFoundEBB
    , Predicate (Event m Symbolic) Tag
tagGetBlockComponentEmptySlot
    , Predicate (Event m Symbolic) Tag
tagGetBlockComponentWrongHash
    , Predicate (Event m Symbolic) Tag
tagGetBlockComponentNewerThanTip
    , Predicate (Event m Symbolic) Tag
tagAppendBlockNotNewerThanTipError
    , Predicate (Event m Symbolic) Tag
tagInvalidIteratorRangeError
    , Map Int Int -> Predicate (Event m Symbolic) Tag
tagIteratorStreamedN Map Int Int
forall k a. Map k a
Map.empty
    , Predicate (Event m Symbolic) Tag
tagCorruption
    , Predicate (Event m Symbolic) Tag
tagMigrate
    , Predicate (Event m Symbolic) Tag
tagGetHashForSlot
    , Tag
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
tagErrorDuring Tag
TagErrorDuringAppendBlock ((At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag)
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \case
      { At (AppendBlock {}) -> Bool
True; At Cmd m Symbolic
_ -> Bool
False }
    , Tag
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
tagErrorDuring Tag
TagErrorDuringGetBlockComponent ((At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag)
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \case
      { At (GetBlockComponent {}) -> Bool
True; At Cmd m Symbolic
_ -> Bool
False }
    , Tag
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
tagErrorDuring Tag
TagErrorDuringStream ((At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag)
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \case
      { At (Stream {}) -> Bool
True ; At Cmd m Symbolic
_ -> Bool
False }
    , Tag
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
tagErrorDuring Tag
TagErrorDuringIteratorNext ((At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag)
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \case
      { At (IteratorNext {}) -> Bool
True; At Cmd m Symbolic
_ -> Bool
False }
    , Tag
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
tagErrorDuring Tag
TagErrorDuringIteratorClose ((At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag)
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \case
       { At (IteratorClose {}) -> Bool
True; At Cmd m Symbolic
_ -> Bool
False }
    ]
  where
    tagGetBlockComponentFound :: EventPred m
    tagGetBlockComponentFound :: Predicate (Event m Symbolic) Tag
tagGetBlockComponentFound = (Event m Symbolic
 -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall (m :: * -> *).
(Event m Symbolic -> Success Int -> Either Tag (EventPred m))
-> EventPred m
successful ((Event m Symbolic
  -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
 -> Predicate (Event m Symbolic) Tag)
-> (Event m Symbolic
    -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
ev Success Int
r -> case Success Int
r of
      ErAllComponents (Right AllComponents TestBlock
_) | GetBlockComponent {} <- At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
At t m r -> t (IterRef m r)
unAt (At Cmd m Symbolic -> Cmd (IterRef m Symbolic))
-> At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
forall a b. (a -> b) -> a -> b
$ Event m Symbolic -> At Cmd m Symbolic
forall (m :: * -> *) (r :: * -> *). Event m r -> At Cmd m r
eventCmdNoErr Event m Symbolic
ev ->
        Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left Tag
TagGetBlockComponentFound
      Success Int
_ -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right Predicate (Event m Symbolic) Tag
tagGetBlockComponentFound

    tagGetBlockComponentFoundEBB :: EventPred m
    tagGetBlockComponentFoundEBB :: Predicate (Event m Symbolic) Tag
tagGetBlockComponentFoundEBB = (Event m Symbolic
 -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall (m :: * -> *).
(Event m Symbolic -> Success Int -> Either Tag (EventPred m))
-> EventPred m
successful ((Event m Symbolic
  -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
 -> Predicate (Event m Symbolic) Tag)
-> (Event m Symbolic
    -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
ev Success Int
r -> case Success Int
r of
      ErAllComponents (Right (TestBlock
_, TestBlock
_, ByteString
_, Header TestBlock
_, ByteString
_, HeaderHash TestBlock
_, SlotNo
_, IsEBB
IsEBB, SizeInBytes
_, Word16
_, SomeSecond (NestedCtxt Header) TestBlock
_))
        | GetBlockComponent {} <- At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
At t m r -> t (IterRef m r)
unAt (At Cmd m Symbolic -> Cmd (IterRef m Symbolic))
-> At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
forall a b. (a -> b) -> a -> b
$ Event m Symbolic -> At Cmd m Symbolic
forall (m :: * -> *) (r :: * -> *). Event m r -> At Cmd m r
eventCmdNoErr Event m Symbolic
ev
        -> Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left Tag
TagGetBlockComponentFoundEBB
      Success Int
_ -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right Predicate (Event m Symbolic) Tag
tagGetBlockComponentFoundEBB

    tagGetBlockComponentEmptySlot :: EventPred m
    tagGetBlockComponentEmptySlot :: Predicate (Event m Symbolic) Tag
tagGetBlockComponentEmptySlot = (Event m Symbolic
 -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall (m :: * -> *).
(Event m Symbolic -> Success Int -> Either Tag (EventPred m))
-> EventPred m
successful ((Event m Symbolic
  -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
 -> Predicate (Event m Symbolic) Tag)
-> (Event m Symbolic
    -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
ev Success Int
r -> case Success Int
r of
      ErAllComponents (Left (EmptySlot {})) | GetBlockComponent {} <- At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
At t m r -> t (IterRef m r)
unAt (At Cmd m Symbolic -> Cmd (IterRef m Symbolic))
-> At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
forall a b. (a -> b) -> a -> b
$ Event m Symbolic -> At Cmd m Symbolic
forall (m :: * -> *) (r :: * -> *). Event m r -> At Cmd m r
eventCmdNoErr Event m Symbolic
ev ->
        Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left Tag
TagGetBlockComponentEmptySlot
      Success Int
_ -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right Predicate (Event m Symbolic) Tag
tagGetBlockComponentEmptySlot

    tagGetBlockComponentWrongHash :: EventPred m
    tagGetBlockComponentWrongHash :: Predicate (Event m Symbolic) Tag
tagGetBlockComponentWrongHash = (Event m Symbolic
 -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall (m :: * -> *).
(Event m Symbolic -> Success Int -> Either Tag (EventPred m))
-> EventPred m
successful ((Event m Symbolic
  -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
 -> Predicate (Event m Symbolic) Tag)
-> (Event m Symbolic
    -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
ev Success Int
r -> case Success Int
r of
      ErAllComponents (Left (WrongHash {})) | GetBlockComponent {} <- At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
At t m r -> t (IterRef m r)
unAt (At Cmd m Symbolic -> Cmd (IterRef m Symbolic))
-> At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
forall a b. (a -> b) -> a -> b
$ Event m Symbolic -> At Cmd m Symbolic
forall (m :: * -> *) (r :: * -> *). Event m r -> At Cmd m r
eventCmdNoErr Event m Symbolic
ev ->
        Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left Tag
TagGetBlockComponentWrongHash
      Success Int
_ -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right Predicate (Event m Symbolic) Tag
tagGetBlockComponentWrongHash

    tagGetBlockComponentNewerThanTip :: EventPred m
    tagGetBlockComponentNewerThanTip :: Predicate (Event m Symbolic) Tag
tagGetBlockComponentNewerThanTip = (Event m Symbolic
 -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall (m :: * -> *).
(Event m Symbolic -> Success Int -> Either Tag (EventPred m))
-> EventPred m
successful ((Event m Symbolic
  -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
 -> Predicate (Event m Symbolic) Tag)
-> (Event m Symbolic
    -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
ev Success Int
r -> case Success Int
r of
      ErAllComponents (Left (NewerThanTip {})) | GetBlockComponent {} <- At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
forall (t :: * -> *) (m :: * -> *) (r :: * -> *).
At t m r -> t (IterRef m r)
unAt (At Cmd m Symbolic -> Cmd (IterRef m Symbolic))
-> At Cmd m Symbolic -> Cmd (IterRef m Symbolic)
forall a b. (a -> b) -> a -> b
$ Event m Symbolic -> At Cmd m Symbolic
forall (m :: * -> *) (r :: * -> *). Event m r -> At Cmd m r
eventCmdNoErr Event m Symbolic
ev ->
        Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left Tag
TagGetBlockComponentNewerThanTip
      Success Int
_ -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right Predicate (Event m Symbolic) Tag
tagGetBlockComponentNewerThanTip

    tagAppendBlockNotNewerThanTipError :: EventPred m
    tagAppendBlockNotNewerThanTipError :: Predicate (Event m Symbolic) Tag
tagAppendBlockNotNewerThanTipError = (Event m Symbolic
 -> ApiMisuse TestBlock
 -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall (m :: * -> *).
(Event m Symbolic
 -> ApiMisuse TestBlock -> Either Tag (EventPred m))
-> EventPred m
failedApiMisuse ((Event m Symbolic
  -> ApiMisuse TestBlock
  -> Either Tag (Predicate (Event m Symbolic) Tag))
 -> Predicate (Event m Symbolic) Tag)
-> (Event m Symbolic
    -> ApiMisuse TestBlock
    -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
_ ApiMisuse TestBlock
e -> case ApiMisuse TestBlock
e of
      AppendBlockNotNewerThanTipError {} -> Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left Tag
TagAppendBlockNotNewerThanTipError
      ApiMisuse TestBlock
_                                  -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right Predicate (Event m Symbolic) Tag
tagAppendBlockNotNewerThanTipError

    tagInvalidIteratorRangeError :: EventPred m
    tagInvalidIteratorRangeError :: Predicate (Event m Symbolic) Tag
tagInvalidIteratorRangeError = (Event m Symbolic
 -> ApiMisuse TestBlock
 -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall (m :: * -> *).
(Event m Symbolic
 -> ApiMisuse TestBlock -> Either Tag (EventPred m))
-> EventPred m
failedApiMisuse ((Event m Symbolic
  -> ApiMisuse TestBlock
  -> Either Tag (Predicate (Event m Symbolic) Tag))
 -> Predicate (Event m Symbolic) Tag)
-> (Event m Symbolic
    -> ApiMisuse TestBlock
    -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
_ ApiMisuse TestBlock
e -> case ApiMisuse TestBlock
e of
      InvalidIteratorRangeError {} -> Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left Tag
TagInvalidIteratorRangeError
      ApiMisuse TestBlock
_                            -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right Predicate (Event m Symbolic) Tag
tagInvalidIteratorRangeError

    tagIteratorStreamedN :: Map IteratorId Int
                         -> EventPred m
    tagIteratorStreamedN :: Map Int Int -> Predicate (Event m Symbolic) Tag
tagIteratorStreamedN Map Int Int
streamedPerIterator = C.Predicate
      { predApply :: Event m Symbolic -> Either Tag (Predicate (Event m Symbolic) Tag)
C.predApply = \Event m Symbolic
ev -> case Event m Symbolic -> Resp Int
forall (m :: * -> *) (r :: * -> *). Event m r -> Resp Int
eventMockResp Event m Symbolic
ev of
          Resp (Right (IterResult (IteratorResult {})))
            | IteratorNext Int
it <- Event m Symbolic -> Cmd Int
forall (r :: * -> *) (m :: * -> *). Eq1 r => Event m r -> Cmd Int
eventMockCmdNoErr Event m Symbolic
ev
            -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right (Predicate (Event m Symbolic) Tag
 -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. (a -> b) -> a -> b
$ Map Int Int -> Predicate (Event m Symbolic) Tag
tagIteratorStreamedN (Map Int Int -> Predicate (Event m Symbolic) Tag)
-> Map Int Int -> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$
               (Int -> Int -> Int) -> Int -> Int -> Map Int Int -> Map Int Int
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
it Int
1 Map Int Int
streamedPerIterator
          Resp Int
_ -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right (Predicate (Event m Symbolic) Tag
 -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. (a -> b) -> a -> b
$ Map Int Int -> Predicate (Event m Symbolic) Tag
tagIteratorStreamedN Map Int Int
streamedPerIterator
      , predFinish :: Maybe Tag
C.predFinish = do
          -- Find the entry with the highest value, i.e. the iterator that has
          (Int
_, Int
longestStream) <- [(Int, Int)] -> Maybe (Int, Int)
forall a. [a] -> Maybe a
listToMaybe ([(Int, Int)] -> Maybe (Int, Int))
-> [(Int, Int)] -> Maybe (Int, Int)
forall a b. (a -> b) -> a -> b
$ ((Int, Int) -> (Int, Int) -> Ordering)
-> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Int -> Int -> Ordering) -> Int -> Int -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((Int, Int) -> Int) -> (Int, Int) -> (Int, Int) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Int, Int) -> Int
forall a b. (a, b) -> b
snd) ([(Int, Int)] -> [(Int, Int)]) -> [(Int, Int)] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$
            Map Int Int -> [(Int, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Int Int
streamedPerIterator
          Tag -> Maybe Tag
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Tag -> Maybe Tag) -> Tag -> Maybe Tag
forall a b. (a -> b) -> a -> b
$ Int -> Tag
TagIteratorStreamedN Int
longestStream
      }

    tagCorruption :: EventPred m
    tagCorruption :: Predicate (Event m Symbolic) Tag
tagCorruption = C.Predicate
      { predApply :: Event m Symbolic -> Either Tag (Predicate (Event m Symbolic) Tag)
C.predApply = \Event m Symbolic
ev -> case Event m Symbolic -> At Cmd m Symbolic
forall (m :: * -> *) (r :: * -> *). Event m r -> At Cmd m r
eventCmdNoErr Event m Symbolic
ev of
          At (Corruption {}) -> Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left  Tag
TagCorruption
          At Cmd m Symbolic
_                  -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right Predicate (Event m Symbolic) Tag
tagCorruption
      , predFinish :: Maybe Tag
C.predFinish = Maybe Tag
forall a. Maybe a
Nothing
      }

    tagMigrate :: EventPred m
    tagMigrate :: Predicate (Event m Symbolic) Tag
tagMigrate = C.Predicate
      { predApply :: Event m Symbolic -> Either Tag (Predicate (Event m Symbolic) Tag)
C.predApply = \Event m Symbolic
ev -> case Event m Symbolic -> At Cmd m Symbolic
forall (m :: * -> *) (r :: * -> *). Event m r -> At Cmd m r
eventCmdNoErr Event m Symbolic
ev of
          At (Migrate {}) -> Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left  Tag
TagMigrate
          At Cmd m Symbolic
_               -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right Predicate (Event m Symbolic) Tag
tagMigrate
      , predFinish :: Maybe Tag
C.predFinish = Maybe Tag
forall a. Maybe a
Nothing
      }

    tagGetHashForSlot :: EventPred m
    tagGetHashForSlot :: Predicate (Event m Symbolic) Tag
tagGetHashForSlot = (Event m Symbolic
 -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall (m :: * -> *).
(Event m Symbolic -> Success Int -> Either Tag (EventPred m))
-> EventPred m
successful ((Event m Symbolic
  -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
 -> Predicate (Event m Symbolic) Tag)
-> (Event m Symbolic
    -> Success Int -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
_ev Success Int
r -> case Success Int
r of
      HashForSlot Maybe TestHeaderHash
mHash -> Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left (Tag -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. (a -> b) -> a -> b
$ Bool -> Tag
TagGetHashForSlot (Bool -> Tag) -> Bool -> Tag
forall a b. (a -> b) -> a -> b
$ Maybe TestHeaderHash -> Bool
forall a. Maybe a -> Bool
isJust Maybe TestHeaderHash
mHash
      Success Int
_                 -> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right Predicate (Event m Symbolic) Tag
tagGetHashForSlot


    tagErrorDuring :: Tag -> (At Cmd m Symbolic -> Bool) -> EventPred m
    tagErrorDuring :: Tag
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
tagErrorDuring Tag
t At Cmd m Symbolic -> Bool
isErr = (Event m Symbolic -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall (m :: * -> *).
(Event m Symbolic -> Either Tag (EventPred m)) -> EventPred m
simulatedError ((Event m Symbolic
  -> Either Tag (Predicate (Event m Symbolic) Tag))
 -> Predicate (Event m Symbolic) Tag)
-> (Event m Symbolic
    -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
forall a b. (a -> b) -> a -> b
$ \Event m Symbolic
ev ->
      if At Cmd m Symbolic -> Bool
isErr (Event m Symbolic -> At Cmd m Symbolic
forall (m :: * -> *) (r :: * -> *). Event m r -> At Cmd m r
eventCmdNoErr Event m Symbolic
ev) then Tag -> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. a -> Either a b
Left Tag
t else Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. b -> Either a b
Right (Predicate (Event m Symbolic) Tag
 -> Either Tag (Predicate (Event m Symbolic) Tag))
-> Predicate (Event m Symbolic) Tag
-> Either Tag (Predicate (Event m Symbolic) Tag)
forall a b. (a -> b) -> a -> b
$ Tag
-> (At Cmd m Symbolic -> Bool) -> Predicate (Event m Symbolic) Tag
tagErrorDuring Tag
t At Cmd m Symbolic -> Bool
isErr


-- | Step the model using a 'QSM.Command' (i.e., a command associated with
-- an explicit set of variables)
execCmd :: Model m Symbolic
        -> QSM.Command (At CmdErr m) (At Resp m)
        -> Event m Symbolic
execCmd :: forall (m :: * -> *).
Model m Symbolic
-> Command (At CmdErr m) (At Resp m) -> Event m Symbolic
execCmd Model m Symbolic
model (QSM.Command At CmdErr m Symbolic
cmdErr At Resp m Symbolic
resp [Var]
_vars) = Model m Symbolic
-> At CmdErr m Symbolic -> At Resp m Symbolic -> Event m Symbolic
forall (r :: * -> *) (m :: * -> *).
(Show1 r, Eq1 r) =>
Model m r -> At CmdErr m r -> At Resp m r -> Event m r
lockstep Model m Symbolic
model At CmdErr m Symbolic
cmdErr At Resp m Symbolic
resp

-- | 'execCmds' is just the repeated form of 'execCmd'
execCmds :: forall m
          . Model m Symbolic
         -> QSM.Commands (At CmdErr m) (At Resp m) -> [Event m Symbolic]
execCmds :: forall (m :: * -> *).
Model m Symbolic
-> Commands (At CmdErr m) (At Resp m) -> [Event m Symbolic]
execCmds Model m Symbolic
model = \(QSM.Commands [Command (At CmdErr m) (At Resp m)]
cs) -> Model m Symbolic
-> [Command (At CmdErr m) (At Resp m)] -> [Event m Symbolic]
go Model m Symbolic
model [Command (At CmdErr m) (At Resp m)]
cs
  where
    go :: Model m Symbolic -> [QSM.Command (At CmdErr m) (At Resp m)]
       -> [Event m Symbolic]
    go :: Model m Symbolic
-> [Command (At CmdErr m) (At Resp m)] -> [Event m Symbolic]
go Model m Symbolic
_ []       = []
    go Model m Symbolic
m (Command (At CmdErr m) (At Resp m)
c : [Command (At CmdErr m) (At Resp m)]
cs) = let ev :: Event m Symbolic
ev = Model m Symbolic
-> Command (At CmdErr m) (At Resp m) -> Event m Symbolic
forall (m :: * -> *).
Model m Symbolic
-> Command (At CmdErr m) (At Resp m) -> Event m Symbolic
execCmd Model m Symbolic
m Command (At CmdErr m) (At Resp m)
c in Event m Symbolic
ev Event m Symbolic -> [Event m Symbolic] -> [Event m Symbolic]
forall a. a -> [a] -> [a]
: Model m Symbolic
-> [Command (At CmdErr m) (At Resp m)] -> [Event m Symbolic]
go (Event m Symbolic -> Model m Symbolic
forall (m :: * -> *) (r :: * -> *). Event m r -> Model m r
eventAfter Event m Symbolic
ev) [Command (At CmdErr m) (At Resp m)]
cs


{-------------------------------------------------------------------------------
  Required instances

  The 'ToExpr' constraints come from "Data.TreeDiff".
-------------------------------------------------------------------------------}

instance CommandNames (At Cmd m) where
  cmdName :: forall (r :: * -> *). At Cmd m r -> String
cmdName (At Cmd (IterRef m r)
cmd) = Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r)
-> String
forall a. HasDatatypeInfo a => a -> String
constrName Cmd (IterRef m r)
Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r)
cmd
  cmdNames :: forall (r :: * -> *). Proxy (At Cmd m r) -> [String]
cmdNames (Proxy (At Cmd m r)
_ :: Proxy (At Cmd m r)) =
    Proxy
  (Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        r))
-> [String]
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> [String]
constrNames (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Cmd (IterRef m r)))

instance CommandNames (At CmdErr m) where
  cmdName :: forall (r :: * -> *). At CmdErr m r -> String
cmdName (At (CmdErr { Cmd (IterRef m r)
cmd :: forall it. CmdErr it -> Cmd it
cmd :: Cmd (IterRef m r)
cmd }) ) = Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r)
-> String
forall a. HasDatatypeInfo a => a -> String
constrName Cmd (IterRef m r)
Cmd
  (Reference
     (Opaque
        (WithEq
           (Iterator
              m
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))))
     r)
cmd
  cmdNames :: forall (r :: * -> *). Proxy (At CmdErr m r) -> [String]
cmdNames (Proxy (At CmdErr m r)
_ :: Proxy (At CmdErr m r)) =
    Proxy
  (Cmd
     (Reference
        (Opaque
           (WithEq
              (Iterator
                 m
                 TestBlock
                 (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
                  TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
                  SomeSecond (NestedCtxt Header) TestBlock))))
        r))
-> [String]
forall a (proxy :: * -> *).
HasDatatypeInfo a =>
proxy a -> [String]
constrNames (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Cmd (IterRef m r)))

instance ToExpr (Model m Concrete)

{-------------------------------------------------------------------------------
  Top-level tests
-------------------------------------------------------------------------------}

-- | Show minimal examples for each of the generated tags
showLabelledExamples'
  :: Maybe Int
  -- ^ Seed
  -> Int
  -- ^ Number of tests to run to find examples
  -> (Tag -> Bool)
  -- ^ Tag filter (can be @const True@)
  -> ChunkInfo
  -> IO ()
showLabelledExamples' :: Maybe Int -> Int -> (Tag -> Bool) -> ChunkInfo -> IO ()
showLabelledExamples' Maybe Int
mbReplay Int
numTests Tag -> Bool
focus ChunkInfo
chunkInfo = do
    Int
replaySeed <- case Maybe Int
mbReplay of
      Maybe Int
Nothing   -> (StdGen -> (Int, StdGen)) -> IO Int
forall (m :: * -> *) a. MonadIO m => (StdGen -> (a, StdGen)) -> m a
getStdRandom ((Int, Int) -> StdGen -> (Int, StdGen)
forall g. RandomGen g => (Int, Int) -> g -> (Int, g)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (Int
1,Int
999999))
      Just Int
seed -> Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int
seed

    Args -> Property -> IO ()
forall prop. Testable prop => Args -> prop -> IO ()
labelledExamplesWith (Args
stdArgs { replay     = Just (mkQCGen replaySeed, 0)
                                  , maxSuccess = numTests
                                  }) (Property -> IO ()) -> Property -> IO ()
forall a b. (a -> b) -> a -> b
$
      Gen (Commands (At CmdErr IO) (At Resp IO))
-> (Commands (At CmdErr IO) (At Resp IO)
    -> [Commands (At CmdErr IO) (At Resp IO)])
-> (Commands (At CmdErr IO) (At Resp IO) -> String)
-> (Commands (At CmdErr IO) (At Resp IO) -> Property)
-> Property
forall prop a.
Testable prop =>
Gen a -> (a -> [a]) -> (a -> String) -> (a -> prop) -> Property
forAllShrinkShow (StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
-> Maybe Int -> Gen (Commands (At CmdErr IO) (At Resp IO))
forall (resp :: (* -> *) -> *) (model :: (* -> *) -> *)
       (cmd :: (* -> *) -> *) (m :: * -> *).
(Foldable resp, Show (model Symbolic), Show (cmd Symbolic),
 Show (resp Symbolic)) =>
StateMachine model cmd m resp
-> Maybe Int -> Gen (Commands cmd resp)
QSM.generateCommands StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
smUnused Maybe Int
forall a. Maybe a
Nothing)
                       (StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
-> Commands (At CmdErr IO) (At Resp IO)
-> [Commands (At CmdErr IO) (At Resp IO)]
forall (model :: (* -> *) -> *) (cmd :: (* -> *) -> *)
       (m :: * -> *) (resp :: (* -> *) -> *).
(Traversable cmd, Foldable resp) =>
StateMachine model cmd m resp
-> Commands cmd resp -> [Commands cmd resp]
QSM.shrinkCommands   StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
smUnused)
                       Commands (At CmdErr IO) (At Resp IO) -> String
forall a. Show a => a -> String
ppShow ((Commands (At CmdErr IO) (At Resp IO) -> Property) -> Property)
-> (Commands (At CmdErr IO) (At Resp IO) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Commands (At CmdErr IO) (At Resp IO)
cmds ->
        [Tag] -> Property -> Property
forall a. Show a => [a] -> Property -> Property
collects ((Tag -> Bool) -> [Tag] -> [Tag]
forall a. (a -> Bool) -> [a] -> [a]
filter Tag -> Bool
focus ([Tag] -> [Tag])
-> (Commands (At CmdErr IO) (At Resp IO) -> [Tag])
-> Commands (At CmdErr IO) (At Resp IO)
-> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Event IO Symbolic] -> [Tag]
forall (m :: * -> *). [Event m Symbolic] -> [Tag]
tag ([Event IO Symbolic] -> [Tag])
-> (Commands (At CmdErr IO) (At Resp IO) -> [Event IO Symbolic])
-> Commands (At CmdErr IO) (At Resp IO)
-> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Model IO Symbolic
-> Commands (At CmdErr IO) (At Resp IO) -> [Event IO Symbolic]
forall (m :: * -> *).
Model m Symbolic
-> Commands (At CmdErr m) (At Resp m) -> [Event m Symbolic]
execCmds (StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
-> forall (r :: * -> *). Model IO r
forall (model :: (* -> *) -> *) (cmd :: (* -> *) -> *)
       (m :: * -> *) (resp :: (* -> *) -> *).
StateMachine model cmd m resp -> forall (r :: * -> *). model r
QSM.initModel StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
smUnused) (Commands (At CmdErr IO) (At Resp IO) -> [Tag])
-> Commands (At CmdErr IO) (At Resp IO) -> [Tag]
forall a b. (a -> b) -> a -> b
$ Commands (At CmdErr IO) (At Resp IO)
cmds) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
  where
    smUnused :: StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
smUnused = ImmutableDBEnv
-> DBModel TestBlock
-> StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
sm ImmutableDBEnv
unusedEnv (DBModel TestBlock
 -> StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO))
-> DBModel TestBlock
-> StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
forall a b. (a -> b) -> a -> b
$ ChunkInfo -> CodecConfig TestBlock -> DBModel TestBlock
forall blk. ChunkInfo -> CodecConfig blk -> DBModel blk
initDBModel ChunkInfo
chunkInfo CodecConfig TestBlock
TestBlockCodecConfig

showLabelledExamples :: ChunkInfo -> IO ()
showLabelledExamples :: ChunkInfo -> IO ()
showLabelledExamples = Maybe Int -> Int -> (Tag -> Bool) -> ChunkInfo -> IO ()
showLabelledExamples' Maybe Int
forall a. Maybe a
Nothing Int
1000 (Bool -> Tag -> Bool
forall a b. a -> b -> a
const Bool
True)

prop_sequential :: Index.CacheConfig -> SmallChunkInfo -> Property
prop_sequential :: CacheConfig -> SmallChunkInfo -> Property
prop_sequential CacheConfig
cacheConfig (SmallChunkInfo ChunkInfo
chunkInfo) =
    StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
-> Maybe Int
-> (Commands (At CmdErr IO) (At Resp IO) -> Property)
-> Property
forall prop (cmd :: (* -> *) -> *) (resp :: (* -> *) -> *)
       (model :: (* -> *) -> *) (m :: * -> *).
(Testable prop, Show (cmd Symbolic), Show (resp Symbolic),
 Show (model Symbolic), Traversable cmd, Foldable resp) =>
StateMachine model cmd m resp
-> Maybe Int -> (Commands cmd resp -> prop) -> Property
forAllCommands StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
smUnused Maybe Int
forall a. Maybe a
Nothing ((Commands (At CmdErr IO) (At Resp IO) -> Property) -> Property)
-> (Commands (At CmdErr IO) (At Resp IO) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Commands (At CmdErr IO) (At Resp IO)
cmds -> PropertyM IO () -> Property
forall a. Testable a => PropertyM IO a -> Property
QC.monadicIO (PropertyM IO () -> Property) -> PropertyM IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
      (History (At CmdErr IO) (At Resp IO)
hist, Property
prop) <- IO (History (At CmdErr IO) (At Resp IO), Property)
-> PropertyM IO (History (At CmdErr IO) (At Resp IO), Property)
forall (m :: * -> *) a. Monad m => m a -> PropertyM m a
QC.run (IO (History (At CmdErr IO) (At Resp IO), Property)
 -> PropertyM IO (History (At CmdErr IO) (At Resp IO), Property))
-> IO (History (At CmdErr IO) (At Resp IO), Property)
-> PropertyM IO (History (At CmdErr IO) (At Resp IO), Property)
forall a b. (a -> b) -> a -> b
$ CacheConfig
-> ChunkInfo
-> Commands (At CmdErr IO) (At Resp IO)
-> IO (History (At CmdErr IO) (At Resp IO), Property)
test CacheConfig
cacheConfig ChunkInfo
chunkInfo Commands (At CmdErr IO) (At Resp IO)
cmds
      StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
-> History (At CmdErr IO) (At Resp IO)
-> Property
-> PropertyM IO ()
forall (m :: * -> *) (model :: (* -> *) -> *)
       (cmd :: (* -> *) -> *) (resp :: (* -> *) -> *).
(MonadIO m, CanDiff (model Concrete), Show (cmd Concrete),
 Show (resp Concrete)) =>
StateMachine model cmd m resp
-> History cmd resp -> Property -> PropertyM m ()
prettyCommands StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
smUnused History (At CmdErr IO) (At Resp IO)
hist
        (Property -> PropertyM IO ()) -> Property -> PropertyM IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Property -> Property
forall prop.
Testable prop =>
String -> [String] -> prop -> Property
tabulate String
"Tags" ((Tag -> String) -> [Tag] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Tag -> String
forall a. Show a => a -> String
show ([Tag] -> [String]) -> [Tag] -> [String]
forall a b. (a -> b) -> a -> b
$ [Event IO Symbolic] -> [Tag]
forall (m :: * -> *). [Event m Symbolic] -> [Tag]
tag (Model IO Symbolic
-> Commands (At CmdErr IO) (At Resp IO) -> [Event IO Symbolic]
forall (m :: * -> *).
Model m Symbolic
-> Commands (At CmdErr m) (At Resp m) -> [Event m Symbolic]
execCmds (StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
-> forall (r :: * -> *). Model IO r
forall (model :: (* -> *) -> *) (cmd :: (* -> *) -> *)
       (m :: * -> *) (resp :: (* -> *) -> *).
StateMachine model cmd m resp -> forall (r :: * -> *). model r
QSM.initModel StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
smUnused) Commands (At CmdErr IO) (At Resp IO)
cmds))
        (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Property
prop
  where
    smUnused :: StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
smUnused = ImmutableDBEnv
-> DBModel TestBlock
-> StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
sm ImmutableDBEnv
unusedEnv (DBModel TestBlock
 -> StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO))
-> DBModel TestBlock
-> StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
forall a b. (a -> b) -> a -> b
$ ChunkInfo -> CodecConfig TestBlock -> DBModel TestBlock
forall blk. ChunkInfo -> CodecConfig blk -> DBModel blk
initDBModel ChunkInfo
chunkInfo CodecConfig TestBlock
TestBlockCodecConfig

test :: Index.CacheConfig
     -> ChunkInfo
     -> QSM.Commands (At CmdErr IO) (At Resp IO)
     -> IO (QSM.History (At CmdErr IO) (At Resp IO), Property)
test :: CacheConfig
-> ChunkInfo
-> Commands (At CmdErr IO) (At Resp IO)
-> IO (History (At CmdErr IO) (At Resp IO), Property)
test CacheConfig
cacheConfig ChunkInfo
chunkInfo Commands (At CmdErr IO) (At Resp IO)
cmds = do
    StrictTMVar IO MockFS
fsVar              <- STM IO (StrictTMVar IO MockFS) -> IO (StrictTMVar IO MockFS)
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO (StrictTMVar IO MockFS) -> IO (StrictTMVar IO MockFS))
-> STM IO (StrictTMVar IO MockFS) -> IO (StrictTMVar IO MockFS)
forall a b. (a -> b) -> a -> b
$ MockFS -> STM IO (StrictTMVar IO MockFS)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar MockFS
Mock.empty
    StrictTVar IO Errors
varErrors          <- Errors -> IO (StrictTVar IO Errors)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM Errors
emptyErrors
    StrictTVar IO Id
varNextId          <- Id -> IO (StrictTVar IO Id)
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM Id
0
    StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
varIters           <- [WithEq
   (Iterator
      IO
      TestBlock
      (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
       TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
       SomeSecond (NestedCtxt Header) TestBlock))]
-> IO
     (StrictTVar
        IO
        [WithEq
           (Iterator
              IO
              TestBlock
              (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
               TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
               SomeSecond (NestedCtxt Header) TestBlock))])
forall (m :: * -> *) a. MonadSTM m => a -> m (StrictTVar m a)
uncheckedNewTVarM []
    (Tracer IO (TraceEvent TestBlock)
tracer, IO [TraceEvent TestBlock]
getTrace) <- IO (Tracer IO (TraceEvent TestBlock), IO [TraceEvent TestBlock])
forall ev. IO (Tracer IO ev, IO [ev])
recordingTracerIORef

    (ResourceRegistry IO
 -> IO (History (At CmdErr IO) (At Resp IO), Property))
-> IO (History (At CmdErr IO) (At Resp IO), Property)
forall (m :: * -> *) a.
(MonadSTM m, MonadMask m, MonadThread m, HasCallStack) =>
(ResourceRegistry m -> m a) -> m a
withRegistry ((ResourceRegistry IO
  -> IO (History (At CmdErr IO) (At Resp IO), Property))
 -> IO (History (At CmdErr IO) (At Resp IO), Property))
-> (ResourceRegistry IO
    -> IO (History (At CmdErr IO) (At Resp IO), Property))
-> IO (History (At CmdErr IO) (At Resp IO), Property)
forall a b. (a -> b) -> a -> b
$ \ResourceRegistry IO
registry -> do
      let hasFS :: HasFS IO HandleMock
hasFS = StrictTMVar IO MockFS
-> StrictTVar IO Errors -> HasFS IO HandleMock
forall (m :: * -> *).
(MonadSTM m, MonadThrow m, PrimMonad m) =>
StrictTMVar m MockFS -> StrictTVar m Errors -> HasFS m HandleMock
simErrorHasFS StrictTMVar IO MockFS
fsVar (StrictTVar IO Errors -> StrictTVar IO Errors
forall (m :: * -> *) a. StrictTVar m a -> StrictTVar m a
unsafeToUncheckedStrictTVar StrictTVar IO Errors
varErrors)
          args :: ImmutableDbArgs Identity IO TestBlock
args  = ImmutableDbArgs {
              immCacheConfig :: CacheConfig
immCacheConfig      = CacheConfig
cacheConfig
            , immCheckIntegrity :: HKD Identity (TestBlock -> Bool)
immCheckIntegrity   = HKD Identity (TestBlock -> Bool)
TestBlock -> Bool
testBlockIsValid
            , immChunkInfo :: HKD Identity ChunkInfo
immChunkInfo        = HKD Identity ChunkInfo
ChunkInfo
chunkInfo
            , immCodecConfig :: HKD Identity (CodecConfig TestBlock)
immCodecConfig      = HKD Identity (CodecConfig TestBlock)
CodecConfig TestBlock
TestBlockCodecConfig
            , immHasFS :: HKD Identity (SomeHasFS IO)
immHasFS            = HasFS IO HandleMock -> SomeHasFS IO
forall h (m :: * -> *). Eq h => HasFS m h -> SomeHasFS m
SomeHasFS HasFS IO HandleMock
hasFS
            , immRegistry :: HKD Identity (ResourceRegistry IO)
immRegistry         = HKD Identity (ResourceRegistry IO)
ResourceRegistry IO
registry
            , immTracer :: Tracer IO (TraceEvent TestBlock)
immTracer           = Tracer IO (TraceEvent TestBlock)
tracer
            , immValidationPolicy :: ValidationPolicy
immValidationPolicy = ValidationPolicy
ValidateMostRecentChunk
            }

      (History (At CmdErr IO) (At Resp IO)
hist, Model IO Concrete
model, Reason
res, [TraceEvent TestBlock]
trace) <- IO (StrictTVar IO ImmutableDBState)
-> (StrictTVar IO ImmutableDBState -> IO ())
-> (StrictTVar IO ImmutableDBState
    -> IO
         (History (At CmdErr IO) (At Resp IO), Model IO Concrete, Reason,
          [TraceEvent TestBlock]))
-> IO
     (History (At CmdErr IO) (At Resp IO), Model IO Concrete, Reason,
      [TraceEvent TestBlock])
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        (ImmutableDbArgs Identity IO TestBlock -> IO ImmutableDBState
open ImmutableDbArgs Identity IO TestBlock
args IO ImmutableDBState
-> (ImmutableDBState -> IO (StrictTVar IO ImmutableDBState))
-> IO (StrictTVar IO ImmutableDBState)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ImmutableDBState -> IO (StrictTVar IO ImmutableDBState)
forall (m :: * -> *) a.
(HasCallStack, MonadSTM m, NoThunks a) =>
a -> m (StrictTVar m a)
newTVarIO)
        -- Note: we might be closing a different ImmutableDB than the one we
        -- opened, as we can reopen it the ImmutableDB, swapping the
        -- ImmutableDB in the TVar.
        (\StrictTVar IO ImmutableDBState
varDB -> StrictTVar IO ImmutableDBState -> IO ImmutableDBState
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> m a
readTVarIO StrictTVar IO ImmutableDBState
varDB IO ImmutableDBState -> (ImmutableDBState -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ImmutableDB IO TestBlock -> IO ()
forall (m :: * -> *) blk. HasCallStack => ImmutableDB m blk -> m ()
closeDB (ImmutableDB IO TestBlock -> IO ())
-> (ImmutableDBState -> ImmutableDB IO TestBlock)
-> ImmutableDBState
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ImmutableDBState -> ImmutableDB IO TestBlock
db)
        ((StrictTVar IO ImmutableDBState
  -> IO
       (History (At CmdErr IO) (At Resp IO), Model IO Concrete, Reason,
        [TraceEvent TestBlock]))
 -> IO
      (History (At CmdErr IO) (At Resp IO), Model IO Concrete, Reason,
       [TraceEvent TestBlock]))
-> (StrictTVar IO ImmutableDBState
    -> IO
         (History (At CmdErr IO) (At Resp IO), Model IO Concrete, Reason,
          [TraceEvent TestBlock]))
-> IO
     (History (At CmdErr IO) (At Resp IO), Model IO Concrete, Reason,
      [TraceEvent TestBlock])
forall a b. (a -> b) -> a -> b
$ \StrictTVar IO ImmutableDBState
varDB -> do
          let env :: ImmutableDBEnv
env = ImmutableDBEnv
                { StrictTVar IO Errors
varErrors :: StrictTVar IO Errors
varErrors :: StrictTVar IO Errors
varErrors
                , StrictTVar IO Id
varNextId :: StrictTVar IO Id
varNextId :: StrictTVar IO Id
varNextId
                , StrictTVar IO [TestIterator IO]
StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
varIters :: StrictTVar IO [TestIterator IO]
varIters :: StrictTVar
  IO
  [WithEq
     (Iterator
        IO
        TestBlock
        (TestBlock, TestBlock, ByteString, Header TestBlock, ByteString,
         TestHeaderHash, SlotNo, IsEBB, SizeInBytes, Word16,
         SomeSecond (NestedCtxt Header) TestBlock))]
varIters
                , StrictTVar IO ImmutableDBState
varDB :: StrictTVar IO ImmutableDBState
varDB :: StrictTVar IO ImmutableDBState
varDB
                , ImmutableDbArgs Identity IO TestBlock
args :: ImmutableDbArgs Identity IO TestBlock
args :: ImmutableDbArgs Identity IO TestBlock
args
                }
              sm' :: StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
sm' = ImmutableDBEnv
-> DBModel TestBlock
-> StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
sm ImmutableDBEnv
env (ChunkInfo -> CodecConfig TestBlock -> DBModel TestBlock
forall blk. ChunkInfo -> CodecConfig blk -> DBModel blk
initDBModel ChunkInfo
chunkInfo CodecConfig TestBlock
TestBlockCodecConfig)

          (History (At CmdErr IO) (At Resp IO)
hist, Model IO Concrete
model, Reason
res) <- StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
-> Commands (At CmdErr IO) (At Resp IO)
-> IO
     (History (At CmdErr IO) (At Resp IO), Model IO Concrete, Reason)
forall (cmd :: (* -> *) -> *) (resp :: (* -> *) -> *) (m :: * -> *)
       (model :: (* -> *) -> *).
(Show (cmd Concrete), Show (resp Concrete), Traversable cmd,
 Foldable resp, MonadMask m, MonadIO m) =>
StateMachine model cmd m resp
-> Commands cmd resp
-> m (History cmd resp, model Concrete, Reason)
QSM.runCommands' StateMachine (Model IO) (At CmdErr IO) IO (At Resp IO)
sm' Commands (At CmdErr IO) (At Resp IO)
cmds

          [TraceEvent TestBlock]
trace <- IO [TraceEvent TestBlock]
getTrace
          (History (At CmdErr IO) (At Resp IO), Model IO Concrete, Reason,
 [TraceEvent TestBlock])
-> IO
     (History (At CmdErr IO) (At Resp IO), Model IO Concrete, Reason,
      [TraceEvent TestBlock])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (History (At CmdErr IO) (At Resp IO)
hist, Model IO Concrete
model, Reason
res, [TraceEvent TestBlock]
trace)

      MockFS
fs <- STM IO MockFS -> IO MockFS
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM IO MockFS -> IO MockFS) -> STM IO MockFS -> IO MockFS
forall a b. (a -> b) -> a -> b
$ StrictTMVar IO MockFS -> STM IO MockFS
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar IO MockFS
fsVar

      let modelTip :: WithOrigin (Tip TestBlock)
modelTip = DBModel TestBlock -> WithOrigin (Tip TestBlock)
forall blk. GetHeader blk => DBModel blk -> WithOrigin (Tip blk)
dbmTip (DBModel TestBlock -> WithOrigin (Tip TestBlock))
-> DBModel TestBlock -> WithOrigin (Tip TestBlock)
forall a b. (a -> b) -> a -> b
$ Model IO Concrete -> DBModel TestBlock
forall (m :: * -> *) (r :: * -> *). Model m r -> DBModel TestBlock
dbModel Model IO Concrete
model
          prop :: Property
prop =
            String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Trace: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines ((TraceEvent TestBlock -> String)
-> [TraceEvent TestBlock] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map TraceEvent TestBlock -> String
forall a. Show a => a -> String
show [TraceEvent TestBlock]
trace)) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
            String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"FS: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MockFS -> String
Mock.pretty MockFS
fs)              (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
            String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"modelTip: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> WithOrigin (Tip TestBlock) -> String
forall a. Show a => a -> String
show WithOrigin (Tip TestBlock)
modelTip)         (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
            Reason
res Reason -> Reason -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Reason
Ok Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. MockFS -> Model IO Concrete -> Property
forall {m :: * -> *} {r :: * -> *}. MockFS -> Model m r -> Property
openHandlesProp MockFS
fs Model IO Concrete
model

      (History (At CmdErr IO) (At Resp IO), Property)
-> IO (History (At CmdErr IO) (At Resp IO), Property)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (History (At CmdErr IO) (At Resp IO)
hist, Property
prop)
  where
    openHandlesProp :: MockFS -> Model m r -> Property
openHandlesProp MockFS
fs Model m r
model
        | Int
openHandles Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxExpectedOpenHandles
        = Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True
        | Bool
otherwise
        = String -> Bool -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
          (String
"open handles: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
openHandles String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
           String
" > max expected open handles: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
           Int -> String
forall a. Show a => a -> String
show Int
maxExpectedOpenHandles) Bool
False
      where
        openHandles :: Int
openHandles = MockFS -> Int
Mock.numOpenHandles MockFS
fs
        -- We're appending to the epoch, so a handle for each of the
        -- three files, plus a handle for the epoch file (to read the
        -- blocks) per open iterator.
        maxExpectedOpenHandles :: Int
maxExpectedOpenHandles = Int
1 {- epoch file -}
                               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 {- primary index file -}
                               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 {- secondary index file -}
                               Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Model m r -> Int
forall (m :: * -> *) (r :: * -> *). Model m r -> Int
nbOpenIterators Model m r
model

tests :: TestTree
tests :: TestTree
tests = String -> [TestTree] -> TestTree
testGroup String
"ImmutableDB q-s-m"
    [ String -> (CacheConfig -> SmallChunkInfo -> Property) -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"sequential" CacheConfig -> SmallChunkInfo -> Property
prop_sequential
    ]

unusedEnv :: ImmutableDBEnv
unusedEnv :: ImmutableDBEnv
unusedEnv = String -> ImmutableDBEnv
forall a. HasCallStack => String -> a
error String
"ImmutableDBEnv used during command generation"