{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Ouroboros.Storage.LedgerDB.V1.BackingStore.Lockstep
  ( BackingStoreState (..)
  , RealEnv (..)
  , RealMonad
  , maxOpenValueHandles
  ) where

import Cardano.Slotting.Slot
import Control.Concurrent.Class.MonadMVar.Strict
import Control.Monad
import Control.Monad.Class.MonadThrow
import Control.Monad.Reader
import Data.Bifunctor
import Data.Constraint
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Typeable
import Ouroboros.Consensus.Ledger.Tables
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore as BS
import qualified Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.InMemory as BS
import Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.Impl.LMDB as LMDB
  ( LMDBErr (..)
  )
import Ouroboros.Consensus.Util.IOLike hiding
  ( MonadMask (..)
  , StrictMVar
  , handle
  , readMVar
  , swapMVar
  )
import System.FS.API hiding (Handle)
import qualified System.FS.API.Types as FS
import Test.Cardano.Ledger.Binary.Arbitrary ()
import Test.Ouroboros.Storage.LedgerDB.V1.BackingStore.Mock
  ( Err (..)
  , Mock (..)
  , ValueHandle (..)
  , runMockMonad
  )
import qualified Test.Ouroboros.Storage.LedgerDB.V1.BackingStore.Mock as Mock
import Test.QuickCheck (Gen)
import qualified Test.QuickCheck as QC
import Test.QuickCheck.StateModel
import Test.QuickCheck.StateModel.Lockstep as Lockstep
import Test.QuickCheck.StateModel.Lockstep.Defaults as Lockstep
import Test.QuickCheck.StateModel.Lockstep.Op.SumProd as Lockstep
import Test.Util.Orphans.Arbitrary ()
import Test.Util.Orphans.ToExpr ()

{-------------------------------------------------------------------------------
  @'Values'@ wrapper
-------------------------------------------------------------------------------}

-- | Wrapper to prevent ambiguity in pattern matches.
newtype Values vs = Values {forall vs. Values vs -> vs
unValues :: vs}
  deriving stock (Int -> Values vs -> ShowS
[Values vs] -> ShowS
Values vs -> String
(Int -> Values vs -> ShowS)
-> (Values vs -> String)
-> ([Values vs] -> ShowS)
-> Show (Values vs)
forall vs. Show vs => Int -> Values vs -> ShowS
forall vs. Show vs => [Values vs] -> ShowS
forall vs. Show vs => Values vs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall vs. Show vs => Int -> Values vs -> ShowS
showsPrec :: Int -> Values vs -> ShowS
$cshow :: forall vs. Show vs => Values vs -> String
show :: Values vs -> String
$cshowList :: forall vs. Show vs => [Values vs] -> ShowS
showList :: [Values vs] -> ShowS
Show, Values vs -> Values vs -> Bool
(Values vs -> Values vs -> Bool)
-> (Values vs -> Values vs -> Bool) -> Eq (Values vs)
forall vs. Eq vs => Values vs -> Values vs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall vs. Eq vs => Values vs -> Values vs -> Bool
== :: Values vs -> Values vs -> Bool
$c/= :: forall vs. Eq vs => Values vs -> Values vs -> Bool
/= :: Values vs -> Values vs -> Bool
Eq, Eq (Values vs)
Eq (Values vs) =>
(Values vs -> Values vs -> Ordering)
-> (Values vs -> Values vs -> Bool)
-> (Values vs -> Values vs -> Bool)
-> (Values vs -> Values vs -> Bool)
-> (Values vs -> Values vs -> Bool)
-> (Values vs -> Values vs -> Values vs)
-> (Values vs -> Values vs -> Values vs)
-> Ord (Values vs)
Values vs -> Values vs -> Bool
Values vs -> Values vs -> Ordering
Values vs -> Values vs -> Values vs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall vs. Ord vs => Eq (Values vs)
forall vs. Ord vs => Values vs -> Values vs -> Bool
forall vs. Ord vs => Values vs -> Values vs -> Ordering
forall vs. Ord vs => Values vs -> Values vs -> Values vs
$ccompare :: forall vs. Ord vs => Values vs -> Values vs -> Ordering
compare :: Values vs -> Values vs -> Ordering
$c< :: forall vs. Ord vs => Values vs -> Values vs -> Bool
< :: Values vs -> Values vs -> Bool
$c<= :: forall vs. Ord vs => Values vs -> Values vs -> Bool
<= :: Values vs -> Values vs -> Bool
$c> :: forall vs. Ord vs => Values vs -> Values vs -> Bool
> :: Values vs -> Values vs -> Bool
$c>= :: forall vs. Ord vs => Values vs -> Values vs -> Bool
>= :: Values vs -> Values vs -> Bool
$cmax :: forall vs. Ord vs => Values vs -> Values vs -> Values vs
max :: Values vs -> Values vs -> Values vs
$cmin :: forall vs. Ord vs => Values vs -> Values vs -> Values vs
min :: Values vs -> Values vs -> Values vs
Ord)
  deriving newtype Gen (Values vs)
Gen (Values vs)
-> (Values vs -> [Values vs]) -> Arbitrary (Values vs)
Values vs -> [Values vs]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
forall vs. Arbitrary vs => Gen (Values vs)
forall vs. Arbitrary vs => Values vs -> [Values vs]
$carbitrary :: forall vs. Arbitrary vs => Gen (Values vs)
arbitrary :: Gen (Values vs)
$cshrink :: forall vs. Arbitrary vs => Values vs -> [Values vs]
shrink :: Values vs -> [Values vs]
QC.Arbitrary

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

data BackingStoreState ks vs d = BackingStoreState
  { forall ks vs d. BackingStoreState ks vs d -> Mock vs
bssMock :: Mock vs
  , forall ks vs d. BackingStoreState ks vs d -> Stats ks vs d
bssStats :: Stats ks vs d
  }
  deriving (Int -> BackingStoreState ks vs d -> ShowS
[BackingStoreState ks vs d] -> ShowS
BackingStoreState ks vs d -> String
(Int -> BackingStoreState ks vs d -> ShowS)
-> (BackingStoreState ks vs d -> String)
-> ([BackingStoreState ks vs d] -> ShowS)
-> Show (BackingStoreState ks vs d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ks vs d.
Show vs =>
Int -> BackingStoreState ks vs d -> ShowS
forall ks vs d. Show vs => [BackingStoreState ks vs d] -> ShowS
forall ks vs d. Show vs => BackingStoreState ks vs d -> String
$cshowsPrec :: forall ks vs d.
Show vs =>
Int -> BackingStoreState ks vs d -> ShowS
showsPrec :: Int -> BackingStoreState ks vs d -> ShowS
$cshow :: forall ks vs d. Show vs => BackingStoreState ks vs d -> String
show :: BackingStoreState ks vs d -> String
$cshowList :: forall ks vs d. Show vs => [BackingStoreState ks vs d] -> ShowS
showList :: [BackingStoreState ks vs d] -> ShowS
Show, BackingStoreState ks vs d -> BackingStoreState ks vs d -> Bool
(BackingStoreState ks vs d -> BackingStoreState ks vs d -> Bool)
-> (BackingStoreState ks vs d -> BackingStoreState ks vs d -> Bool)
-> Eq (BackingStoreState ks vs d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ks vs d.
Eq vs =>
BackingStoreState ks vs d -> BackingStoreState ks vs d -> Bool
$c== :: forall ks vs d.
Eq vs =>
BackingStoreState ks vs d -> BackingStoreState ks vs d -> Bool
== :: BackingStoreState ks vs d -> BackingStoreState ks vs d -> Bool
$c/= :: forall ks vs d.
Eq vs =>
BackingStoreState ks vs d -> BackingStoreState ks vs d -> Bool
/= :: BackingStoreState ks vs d -> BackingStoreState ks vs d -> Bool
Eq)

initState :: Mock.EmptyValues vs => BackingStoreState ks vs d
initState :: forall vs ks d. EmptyValues vs => BackingStoreState ks vs d
initState =
  BackingStoreState
    { bssMock :: Mock vs
bssMock = Mock vs
forall vs. EmptyValues vs => Mock vs
Mock.emptyMock
    , bssStats :: Stats ks vs d
bssStats = Stats ks vs d
forall ks vs d. Stats ks vs d
initStats
    }

-- | Maximum number of LMDB readers that can be active at a time.
--
-- 32 is an arbitrary number of readers. We can increase or decrease this at
-- will.
maxOpenValueHandles :: Int
maxOpenValueHandles :: Int
maxOpenValueHandles = Int
32

{-------------------------------------------------------------------------------
  @'StateModel'@ and @'RunModel'@ instances
-------------------------------------------------------------------------------}

type BackingStoreInitializer m ks vs d =
  BS.InitFrom vs ->
  m (BS.BackingStore m ks vs d)

data RealEnv m ks vs d = RealEnv
  { forall (m :: * -> *) ks vs d.
RealEnv m ks vs d -> BackingStoreInitializer m ks vs d
reBackingStoreInit :: BackingStoreInitializer m ks vs d
  , forall (m :: * -> *) ks vs d.
RealEnv m ks vs d -> StrictMVar m (BackingStore m ks vs d)
reBackingStore :: StrictMVar m (BS.BackingStore m ks vs d)
  }

type RealMonad m ks vs d = ReaderT (RealEnv m ks vs d) m

type BSAct ks vs d a =
  Action
    (Lockstep (BackingStoreState ks vs d))
    (Either Err a)
type BSVar ks vs d a =
  ModelVar (BackingStoreState ks vs d) a

instance
  ( Show ks
  , Show vs
  , Show d
  , Show (BS.InitHint vs)
  , Show (BS.WriteHint d)
  , Show (BS.ReadHint vs)
  , Eq ks
  , Eq vs
  , Eq d
  , Eq (BS.InitHint vs)
  , Eq (BS.WriteHint d)
  , Eq (BS.ReadHint vs)
  , Typeable ks
  , Typeable vs
  , Typeable d
  , Typeable (BS.WriteHint d)
  , QC.Arbitrary ks
  , QC.Arbitrary vs
  , QC.Arbitrary d
  , QC.Arbitrary (BS.RangeQuery ks)
  , Mock.HasOps ks vs d
  ) =>
  StateModel (Lockstep (BackingStoreState ks vs d))
  where
  data Action (Lockstep (BackingStoreState ks vs d)) a where
    -- Reopen a backing store by intialising from values.
    BSInitFromValues ::
      WithOrigin SlotNo ->
      BS.InitHint vs ->
      Values vs ->
      BSAct ks vs d ()
    -- Reopen a backing store by initialising from a copy.
    BSInitFromCopy ::
      BS.InitHint vs ->
      FS.FsPath ->
      BSAct ks vs d ()
    BSClose :: BSAct ks vs d ()
    BSCopy ::
      SerializeTablesHint vs ->
      FS.FsPath ->
      BSAct ks vs d ()
    BSValueHandle :: BSAct ks vs d (BS.BackingStoreValueHandle IO ks vs)
    BSWrite ::
      SlotNo ->
      BS.WriteHint d ->
      d ->
      BSAct ks vs d ()
    BSVHClose ::
      BSVar ks vs d (BS.BackingStoreValueHandle IO ks vs) ->
      BSAct ks vs d ()
    BSVHRangeRead ::
      BSVar ks vs d (BS.BackingStoreValueHandle IO ks vs) ->
      BS.ReadHint vs ->
      BS.RangeQuery ks ->
      BSAct ks vs d (Values vs)
    BSVHRead ::
      BSVar ks vs d (BS.BackingStoreValueHandle IO ks vs) ->
      BS.ReadHint vs ->
      ks ->
      BSAct ks vs d (Values vs)
    BSVHAtSlot ::
      BSVar ks vs d (BS.BackingStoreValueHandle IO ks vs) ->
      BSAct ks vs d (WithOrigin SlotNo)
    -- \| Corresponds to 'bsvhStat'
    BSVHStat ::
      BSVar ks vs d (BS.BackingStoreValueHandle IO ks vs) ->
      BSAct ks vs d BS.Statistics

  initialState :: Lockstep (BackingStoreState ks vs d)
initialState = BackingStoreState ks vs d -> Lockstep (BackingStoreState ks vs d)
forall state. state -> Lockstep state
Lockstep.initialState BackingStoreState ks vs d
forall vs ks d. EmptyValues vs => BackingStoreState ks vs d
initState
  nextState :: forall a.
Typeable a =>
Lockstep (BackingStoreState ks vs d)
-> Action (Lockstep (BackingStoreState ks vs d)) a
-> Var a
-> Lockstep (BackingStoreState ks vs d)
nextState = Lockstep (BackingStoreState ks vs d)
-> LockstepAction (BackingStoreState ks vs d) a
-> Var a
-> Lockstep (BackingStoreState ks vs d)
forall state a.
(InLockstep state, Typeable a) =>
Lockstep state -> LockstepAction state a -> Var a -> Lockstep state
Lockstep.nextState
  precondition :: forall a.
Lockstep (BackingStoreState ks vs d)
-> Action (Lockstep (BackingStoreState ks vs d)) a -> Bool
precondition Lockstep (BackingStoreState ks vs d)
st Action (Lockstep (BackingStoreState ks vs d)) a
act =
    Lockstep (BackingStoreState ks vs d)
-> Action (Lockstep (BackingStoreState ks vs d)) a -> Bool
forall state a.
InLockstep state =>
Lockstep state -> LockstepAction state a -> Bool
Lockstep.precondition Lockstep (BackingStoreState ks vs d)
st Action (Lockstep (BackingStoreState ks vs d)) a
act
      Bool -> Bool -> Bool
&& BackingStoreState ks vs d
-> Action (Lockstep (BackingStoreState ks vs d)) a -> Bool
forall ks vs d a.
BackingStoreState ks vs d
-> LockstepAction (BackingStoreState ks vs d) a -> Bool
modelPrecondition (Lockstep (BackingStoreState ks vs d) -> BackingStoreState ks vs d
forall state. Lockstep state -> state
getModel Lockstep (BackingStoreState ks vs d)
st) Action (Lockstep (BackingStoreState ks vs d)) a
act
  arbitraryAction :: VarContext
-> Lockstep (BackingStoreState ks vs d)
-> Gen (Any (Action (Lockstep (BackingStoreState ks vs d))))
arbitraryAction = VarContext
-> Lockstep (BackingStoreState ks vs d)
-> Gen (Any (Action (Lockstep (BackingStoreState ks vs d))))
forall state.
InLockstep state =>
VarContext -> Lockstep state -> Gen (Any (LockstepAction state))
Lockstep.arbitraryAction
  shrinkAction :: forall a.
Typeable a =>
VarContext
-> Lockstep (BackingStoreState ks vs d)
-> Action (Lockstep (BackingStoreState ks vs d)) a
-> [Any (Action (Lockstep (BackingStoreState ks vs d)))]
shrinkAction = VarContext
-> Lockstep (BackingStoreState ks vs d)
-> LockstepAction (BackingStoreState ks vs d) a
-> [Any (Action (Lockstep (BackingStoreState ks vs d)))]
forall state a.
InLockstep state =>
VarContext
-> Lockstep state
-> LockstepAction state a
-> [Any (LockstepAction state)]
Lockstep.shrinkAction

deriving stock instance
  ( Show ks
  , Show vs
  , Show d
  , Show (BS.InitHint vs)
  , Show (BS.WriteHint d)
  , Show (BS.ReadHint vs)
  , Show (SerializeTablesHint vs)
  ) =>
  Show (LockstepAction (BackingStoreState ks vs d) a)
deriving stock instance
  ( Eq ks
  , Eq vs
  , Eq d
  , Eq (BS.InitHint vs)
  , Eq (BS.WriteHint d)
  , Eq (BS.ReadHint vs)
  , Eq (SerializeTablesHint vs)
  ) =>
  Eq (LockstepAction (BackingStoreState ks vs d) a)

instance
  ( Show ks
  , Show vs
  , Show d
  , Show (BS.InitHint vs)
  , Show (BS.WriteHint d)
  , Show (BS.ReadHint vs)
  , Eq ks
  , Eq vs
  , Eq d
  , Eq (BS.InitHint vs)
  , Eq (BS.WriteHint d)
  , Eq (BS.ReadHint vs)
  , Typeable ks
  , Typeable vs
  , Typeable d
  , Typeable (BS.WriteHint d)
  , QC.Arbitrary ks
  , QC.Arbitrary vs
  , QC.Arbitrary d
  , QC.Arbitrary (BS.RangeQuery ks)
  , Mock.HasOps ks vs d
  ) =>
  RunModel
    (Lockstep (BackingStoreState ks vs d))
    (RealMonad IO ks vs d)
  where
  perform :: forall a.
Typeable a =>
Lockstep (BackingStoreState ks vs d)
-> Action (Lockstep (BackingStoreState ks vs d)) a
-> LookUp (RealMonad IO ks vs d)
-> RealMonad
     IO
     ks
     vs
     d
     (PerformResult
        (Error (Lockstep (BackingStoreState ks vs d)))
        (Realized (RealMonad IO ks vs d) a))
perform = \Lockstep (BackingStoreState ks vs d)
_st -> Action (Lockstep (BackingStoreState ks vs d)) a
-> LookUp (RealMonad IO ks vs d)
-> RealMonad IO ks vs d (Realized (RealMonad IO ks vs d) a)
Action (Lockstep (BackingStoreState ks vs d)) a
-> LookUp (RealMonad IO ks vs d)
-> RealMonad
     IO
     ks
     vs
     d
     (PerformResult
        (Error (Lockstep (BackingStoreState ks vs d)))
        (Realized (RealMonad IO ks vs d) a))
forall ks vs d a.
LockstepAction (BackingStoreState ks vs d) a
-> LookUp (RealMonad IO ks vs d)
-> RealMonad IO ks vs d (Realized (RealMonad IO ks vs d) a)
runIO
  postcondition :: forall a.
(Lockstep (BackingStoreState ks vs d),
 Lockstep (BackingStoreState ks vs d))
-> Action (Lockstep (BackingStoreState ks vs d)) a
-> LookUp (RealMonad IO ks vs d)
-> Realized (RealMonad IO ks vs d) a
-> PostconditionM (RealMonad IO ks vs d) Bool
postcondition = (Lockstep (BackingStoreState ks vs d),
 Lockstep (BackingStoreState ks vs d))
-> LockstepAction (BackingStoreState ks vs d) a
-> LookUp (RealMonad IO ks vs d)
-> Realized (RealMonad IO ks vs d) a
-> PostconditionM (RealMonad IO ks vs d) Bool
forall (m :: * -> *) state a.
RunLockstep state m =>
(Lockstep state, Lockstep state)
-> LockstepAction state a
-> LookUp m
-> Realized m a
-> PostconditionM m Bool
Lockstep.postcondition
  monitoring :: forall a.
(Lockstep (BackingStoreState ks vs d),
 Lockstep (BackingStoreState ks vs d))
-> Action (Lockstep (BackingStoreState ks vs d)) a
-> LookUp (RealMonad IO ks vs d)
-> Either
     (Error (Lockstep (BackingStoreState ks vs d)))
     (Realized (RealMonad IO ks vs d) a)
-> Property
-> Property
monitoring = Proxy (RealMonad IO ks vs d)
-> (Lockstep (BackingStoreState ks vs d),
    Lockstep (BackingStoreState ks vs d))
-> Action (Lockstep (BackingStoreState ks vs d)) a
-> LookUp (RealMonad IO ks vs d)
-> Either
     (Error (Lockstep (BackingStoreState ks vs d)))
     (Realized (RealMonad IO ks vs d) a)
-> Property
-> Property
forall (m :: * -> *) state a.
RunLockstep state m =>
Proxy m
-> (Lockstep state, Lockstep state)
-> LockstepAction state a
-> LookUp m
-> Either (Error (Lockstep state)) (Realized m a)
-> Property
-> Property
Lockstep.monitoring (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(RealMonad IO ks vs d))

-- | Custom precondition that prevents errors in the @'LMDB'@ backing store due
-- to exceeding the maximum number of LMDB readers.
--
-- See @'maxOpenValueHandles'@.
modelPrecondition ::
  BackingStoreState ks vs d ->
  LockstepAction (BackingStoreState ks vs d) a ->
  Bool
modelPrecondition :: forall ks vs d a.
BackingStoreState ks vs d
-> LockstepAction (BackingStoreState ks vs d) a -> Bool
modelPrecondition (BackingStoreState Mock vs
mock Stats ks vs d
_stats) LockstepAction (BackingStoreState ks vs d) a
action = case LockstepAction (BackingStoreState ks vs d) a
action of
  BSInitFromValues WithOrigin SlotNo
_ InitHint vs
_ Values vs
_ -> Mock vs -> Bool
forall vs. Mock vs -> Bool
isClosed Mock vs
mock
  BSInitFromCopy InitHint vs
_ FsPath
_ -> Mock vs -> Bool
forall vs. Mock vs -> Bool
isClosed Mock vs
mock
  BSCopy SerializeTablesHint vs
_ FsPath
_ -> Bool
canOpenReader
  LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSValueHandle -> Bool
canOpenReader
  LockstepAction (BackingStoreState ks vs d) a
_ -> Bool
True
 where
  canOpenReader :: Bool
canOpenReader = Map ID ValueHandleStatus -> Int
forall k a. Map k a -> Int
Map.size Map ID ValueHandleStatus
openValueHandles Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxOpenValueHandles
  openValueHandles :: Map ID ValueHandleStatus
openValueHandles = (ValueHandleStatus -> Bool)
-> Map ID ValueHandleStatus -> Map ID ValueHandleStatus
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (ValueHandleStatus -> ValueHandleStatus -> Bool
forall a. Eq a => a -> a -> Bool
== ValueHandleStatus
Mock.Open) (Mock vs -> Map ID ValueHandleStatus
forall vs. Mock vs -> Map ID ValueHandleStatus
valueHandles Mock vs
mock)

{-------------------------------------------------------------------------------
  @'InLockstep'@ instance
-------------------------------------------------------------------------------}

type BSVal ks vs d a = ModelValue (BackingStoreState ks vs d) a
type BSObs ks vs d a = Observable (BackingStoreState ks vs d) a

instance
  ( Show ks
  , Show vs
  , Show d
  , Show (BS.InitHint vs)
  , Show (BS.WriteHint d)
  , Show (BS.ReadHint vs)
  , Eq ks
  , Eq vs
  , Eq d
  , Eq (BS.InitHint vs)
  , Eq (BS.WriteHint d)
  , Eq (BS.ReadHint vs)
  , Typeable ks
  , Typeable vs
  , Typeable d
  , Typeable (BS.WriteHint d)
  , QC.Arbitrary ks
  , QC.Arbitrary vs
  , QC.Arbitrary d
  , QC.Arbitrary (BS.RangeQuery ks)
  , Mock.HasOps ks vs d
  ) =>
  InLockstep (BackingStoreState ks vs d)
  where
  data ModelValue (BackingStoreState ks vs d) a where
    MValueHandle :: ValueHandle vs -> BSVal ks vs d (BS.BackingStoreValueHandle IO ks vs)
    MErr ::
      Err ->
      BSVal ks vs d Err
    MSlotNo ::
      WithOrigin SlotNo ->
      BSVal ks vs d (WithOrigin SlotNo)
    MValues ::
      vs ->
      BSVal ks vs d (Values vs)
    MUnit ::
      () ->
      BSVal ks vs d ()
    MStatistics ::
      BS.Statistics ->
      BSVal ks vs d BS.Statistics
    MEither ::
      Either (BSVal ks vs d a) (BSVal ks vs d b) ->
      BSVal ks vs d (Either a b)
    MPair ::
      (BSVal ks vs d a, BSVal ks vs d b) ->
      BSVal ks vs d (a, b)

  data Observable (BackingStoreState ks vs d) a where
    OValueHandle :: BSObs ks vs d (BS.BackingStoreValueHandle IO ks vs)
    OValues :: (Show a, Eq a, Typeable a) => a -> BSObs ks vs d (Values a)
    OId :: (Show a, Eq a, Typeable a) => a -> BSObs ks vs d a
    OEither ::
      Either (BSObs ks vs d a) (BSObs ks vs d b) ->
      BSObs ks vs d (Either a b)
    OPair :: (BSObs ks vs d a, BSObs ks vs d b) -> BSObs ks vs d (a, b)

  observeModel :: BSVal ks vs d a -> BSObs ks vs d a
  observeModel :: forall a.
ModelValue (BackingStoreState ks vs d) a
-> Observable (BackingStoreState ks vs d) a
observeModel = \case
    MValueHandle ValueHandle vs
_ -> BSObs ks vs d a
BSObs ks vs d (BackingStoreValueHandle IO ks vs)
forall ks vs d. BSObs ks vs d (BackingStoreValueHandle IO ks vs)
OValueHandle
    MErr Err
x -> a -> BSObs ks vs d a
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId a
Err
x
    MSlotNo WithOrigin SlotNo
x -> a -> BSObs ks vs d a
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId a
WithOrigin SlotNo
x
    MValues vs
x -> vs -> BSObs ks vs d (Values vs)
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d (Values a)
OValues vs
x
    MUnit ()
x -> a -> BSObs ks vs d a
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId a
()
x
    MStatistics Statistics
x -> a -> BSObs ks vs d a
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId a
Statistics
x
    MEither Either (BSVal ks vs d a) (BSVal ks vs d b)
x -> Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d a) (BSObs ks vs d b)
 -> BSObs ks vs d (Either a b))
-> Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
forall a b. (a -> b) -> a -> b
$ (BSVal ks vs d a -> BSObs ks vs d a)
-> (BSVal ks vs d b -> BSObs ks vs d b)
-> Either (BSVal ks vs d a) (BSVal ks vs d b)
-> Either (BSObs ks vs d a) (BSObs ks vs d b)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap BSVal ks vs d a -> BSObs ks vs d a
forall state a.
InLockstep state =>
ModelValue state a -> Observable state a
forall a.
ModelValue (BackingStoreState ks vs d) a
-> Observable (BackingStoreState ks vs d) a
observeModel BSVal ks vs d b -> BSObs ks vs d b
forall state a.
InLockstep state =>
ModelValue state a -> Observable state a
forall a.
ModelValue (BackingStoreState ks vs d) a
-> Observable (BackingStoreState ks vs d) a
observeModel Either (BSVal ks vs d a) (BSVal ks vs d b)
x
    MPair (BSVal ks vs d a, BSVal ks vs d b)
x -> (BSObs ks vs d a, BSObs ks vs d b) -> BSObs ks vs d (a, b)
forall ks vs d a b.
(BSObs ks vs d a, BSObs ks vs d b) -> BSObs ks vs d (a, b)
OPair ((BSObs ks vs d a, BSObs ks vs d b) -> BSObs ks vs d (a, b))
-> (BSObs ks vs d a, BSObs ks vs d b) -> BSObs ks vs d (a, b)
forall a b. (a -> b) -> a -> b
$ (BSVal ks vs d a -> BSObs ks vs d a)
-> (BSVal ks vs d b -> BSObs ks vs d b)
-> (BSVal ks vs d a, BSVal ks vs d b)
-> (BSObs ks vs d a, BSObs ks vs d b)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap BSVal ks vs d a -> BSObs ks vs d a
forall state a.
InLockstep state =>
ModelValue state a -> Observable state a
forall a.
ModelValue (BackingStoreState ks vs d) a
-> Observable (BackingStoreState ks vs d) a
observeModel BSVal ks vs d b -> BSObs ks vs d b
forall state a.
InLockstep state =>
ModelValue state a -> Observable state a
forall a.
ModelValue (BackingStoreState ks vs d) a
-> Observable (BackingStoreState ks vs d) a
observeModel (BSVal ks vs d a, BSVal ks vs d b)
x

  modelNextState ::
    forall a.
    LockstepAction (BackingStoreState ks vs d) a ->
    ModelVarContext (BackingStoreState ks vs d) ->
    BackingStoreState ks vs d ->
    (BSVal ks vs d a, BackingStoreState ks vs d)
  modelNextState :: forall a.
LockstepAction (BackingStoreState ks vs d) a
-> ModelVarContext (BackingStoreState ks vs d)
-> BackingStoreState ks vs d
-> (ModelValue (BackingStoreState ks vs d) a,
    BackingStoreState ks vs d)
modelNextState LockstepAction (BackingStoreState ks vs d) a
action ModelVarContext (BackingStoreState ks vs d)
lookUp (BackingStoreState Mock vs
mock Stats ks vs d
stats) =
    (BSVal ks vs d a, Mock vs)
-> (BSVal ks vs d a, BackingStoreState ks vs d)
auxStats ((BSVal ks vs d a, Mock vs)
 -> (BSVal ks vs d a, BackingStoreState ks vs d))
-> (BSVal ks vs d a, Mock vs)
-> (BSVal ks vs d a, BackingStoreState ks vs d)
forall a b. (a -> b) -> a -> b
$ ModelVarContext (BackingStoreState ks vs d)
-> LockstepAction (BackingStoreState ks vs d) a
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall ks vs d a.
(HasOps ks vs d, Arbitrary ks, Arbitrary vs, Arbitrary d,
 Arbitrary (RangeQuery ks)) =>
ModelVarContext (BackingStoreState ks vs d)
-> Action (Lockstep (BackingStoreState ks vs d)) a
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
runMock ModelVarContext (BackingStoreState ks vs d)
lookUp LockstepAction (BackingStoreState ks vs d) a
action Mock vs
mock
   where
    auxStats ::
      (BSVal ks vs d a, Mock vs) ->
      (BSVal ks vs d a, BackingStoreState ks vs d)
    auxStats :: (BSVal ks vs d a, Mock vs)
-> (BSVal ks vs d a, BackingStoreState ks vs d)
auxStats (BSVal ks vs d a
result, Mock vs
state') =
      ( BSVal ks vs d a
result
      , Mock vs -> Stats ks vs d -> BackingStoreState ks vs d
forall ks vs d.
Mock vs -> Stats ks vs d -> BackingStoreState ks vs d
BackingStoreState Mock vs
state' (Stats ks vs d -> BackingStoreState ks vs d)
-> Stats ks vs d -> BackingStoreState ks vs d
forall a b. (a -> b) -> a -> b
$ LockstepAction (BackingStoreState ks vs d) a
-> ModelVarContext (BackingStoreState ks vs d)
-> BSVal ks vs d a
-> Stats ks vs d
-> Stats ks vs d
forall ks vs d a.
(HasOps ks vs d, Arbitrary ks, Arbitrary vs, Arbitrary d,
 Arbitrary (RangeQuery ks)) =>
LockstepAction (BackingStoreState ks vs d) a
-> ModelVarContext (BackingStoreState ks vs d)
-> BSVal ks vs d a
-> Stats ks vs d
-> Stats ks vs d
updateStats LockstepAction (BackingStoreState ks vs d) a
action ModelVarContext (BackingStoreState ks vs d)
lookUp BSVal ks vs d a
result Stats ks vs d
stats
      )

  type ModelOp (BackingStoreState ks vs d) = Op

  usedVars ::
    LockstepAction (BackingStoreState ks vs d) a ->
    [AnyGVar (ModelOp (BackingStoreState ks vs d))]
  usedVars :: forall a.
LockstepAction (BackingStoreState ks vs d) a
-> [AnyGVar (ModelOp (BackingStoreState ks vs d))]
usedVars = \case
    BSInitFromValues WithOrigin SlotNo
_ InitHint vs
_ Values vs
_ -> []
    BSInitFromCopy InitHint vs
_ FsPath
_ -> []
    LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSClose -> []
    BSCopy SerializeTablesHint vs
_ FsPath
_ -> []
    LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSValueHandle -> []
    BSWrite SlotNo
_ WriteHint d
_ d
_ -> []
    BSVHClose BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h -> [GVar Op (BackingStoreValueHandle IO ks vs) -> AnyGVar Op
forall (op :: * -> * -> *) y. GVar op y -> AnyGVar op
SomeGVar BSVar ks vs d (BackingStoreValueHandle IO ks vs)
GVar Op (BackingStoreValueHandle IO ks vs)
h]
    BSVHRangeRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ReadHint vs
_ RangeQuery ks
_ -> [GVar Op (BackingStoreValueHandle IO ks vs) -> AnyGVar Op
forall (op :: * -> * -> *) y. GVar op y -> AnyGVar op
SomeGVar BSVar ks vs d (BackingStoreValueHandle IO ks vs)
GVar Op (BackingStoreValueHandle IO ks vs)
h]
    BSVHRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ReadHint vs
_ ks
_ -> [GVar Op (BackingStoreValueHandle IO ks vs) -> AnyGVar Op
forall (op :: * -> * -> *) y. GVar op y -> AnyGVar op
SomeGVar BSVar ks vs d (BackingStoreValueHandle IO ks vs)
GVar Op (BackingStoreValueHandle IO ks vs)
h]
    BSVHAtSlot BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h -> [GVar Op (BackingStoreValueHandle IO ks vs) -> AnyGVar Op
forall (op :: * -> * -> *) y. GVar op y -> AnyGVar op
SomeGVar BSVar ks vs d (BackingStoreValueHandle IO ks vs)
GVar Op (BackingStoreValueHandle IO ks vs)
h]
    BSVHStat BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h -> [GVar Op (BackingStoreValueHandle IO ks vs) -> AnyGVar Op
forall (op :: * -> * -> *) y. GVar op y -> AnyGVar op
SomeGVar BSVar ks vs d (BackingStoreValueHandle IO ks vs)
GVar Op (BackingStoreValueHandle IO ks vs)
h]

  arbitraryWithVars ::
    ModelVarContext (BackingStoreState ks vs d) ->
    BackingStoreState ks vs d ->
    Gen (Any (LockstepAction (BackingStoreState ks vs d)))
  arbitraryWithVars :: ModelVarContext (BackingStoreState ks vs d)
-> BackingStoreState ks vs d
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
arbitraryWithVars = ModelVarContext (BackingStoreState ks vs d)
-> BackingStoreState ks vs d
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall ks vs d.
(HasOps ks vs d, Arbitrary ks, Arbitrary vs, Arbitrary d,
 Arbitrary (RangeQuery ks)) =>
ModelVarContext (BackingStoreState ks vs d)
-> BackingStoreState ks vs d
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
arbitraryBackingStoreAction

  shrinkWithVars ::
    ModelVarContext (BackingStoreState ks vs d) ->
    BackingStoreState ks vs d ->
    LockstepAction (BackingStoreState ks vs d) a ->
    [Any (LockstepAction (BackingStoreState ks vs d))]
  shrinkWithVars :: forall a.
ModelVarContext (BackingStoreState ks vs d)
-> BackingStoreState ks vs d
-> LockstepAction (BackingStoreState ks vs d) a
-> [Any (LockstepAction (BackingStoreState ks vs d))]
shrinkWithVars = ModelVarContext (BackingStoreState ks vs d)
-> BackingStoreState ks vs d
-> LockstepAction (BackingStoreState ks vs d) a
-> [Any (LockstepAction (BackingStoreState ks vs d))]
forall ks vs d a.
(Typeable vs, Eq ks, Eq vs, Eq d, Eq (InitHint vs),
 Eq (WriteHint d), Eq (ReadHint vs), Eq (SerializeTablesHint vs),
 Arbitrary d, Arbitrary (RangeQuery ks), Arbitrary ks) =>
ModelVarContext (BackingStoreState ks vs d)
-> BackingStoreState ks vs d
-> LockstepAction (BackingStoreState ks vs d) a
-> [Any (LockstepAction (BackingStoreState ks vs d))]
shrinkBackingStoreAction

  tagStep ::
    (BackingStoreState ks vs d, BackingStoreState ks vs d) ->
    LockstepAction (BackingStoreState ks vs d) a ->
    BSVal ks vs d a ->
    [String]
  tagStep :: forall a.
(BackingStoreState ks vs d, BackingStoreState ks vs d)
-> LockstepAction (BackingStoreState ks vs d) a
-> ModelValue (BackingStoreState ks vs d) a
-> [String]
tagStep (BackingStoreState Mock vs
_ Stats ks vs d
before, BackingStoreState Mock vs
_ Stats ks vs d
after) LockstepAction (BackingStoreState ks vs d) a
action BSVal ks vs d a
val =
    (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
$ Stats ks vs d
-> Stats ks vs d
-> LockstepAction (BackingStoreState ks vs d) a
-> BSVal ks vs d a
-> [Tag]
forall ks vs d a.
Stats ks vs d
-> Stats ks vs d
-> LockstepAction (BackingStoreState ks vs d) a
-> BSVal ks vs d a
-> [Tag]
tagBSAction Stats ks vs d
before Stats ks vs d
after LockstepAction (BackingStoreState ks vs d) a
action BSVal ks vs d a
val

deriving stock instance
  ( Show ks
  , Show vs
  , Show d
  , Show (BS.WriteHint d)
  , Show (BS.ReadHint vs)
  ) =>
  Show (BSVal ks vs d a)

deriving stock instance
  ( Show ks
  , Show vs
  , Show d
  , Show (BS.WriteHint d)
  , Show (BS.ReadHint vs)
  ) =>
  Show (BSObs ks vs d a)

deriving stock instance
  ( Eq ks
  , Eq vs
  , Eq d
  , Eq (BS.WriteHint d)
  , Eq (BS.ReadHint vs)
  ) =>
  Eq (BSObs ks vs d a)

{-------------------------------------------------------------------------------
  @'RunLockstep'@ instance
-------------------------------------------------------------------------------}

instance
  ( Show ks
  , Show vs
  , Show d
  , Show (BS.InitHint vs)
  , Show (BS.WriteHint d)
  , Show (BS.ReadHint vs)
  , Eq ks
  , Eq vs
  , Eq d
  , Eq (BS.InitHint vs)
  , Eq (BS.WriteHint d)
  , Eq (BS.ReadHint vs)
  , Typeable ks
  , Typeable vs
  , Typeable d
  , Typeable (BS.WriteHint d)
  , QC.Arbitrary ks
  , QC.Arbitrary vs
  , QC.Arbitrary d
  , QC.Arbitrary (BS.RangeQuery ks)
  , Mock.HasOps ks vs d
  ) =>
  RunLockstep (BackingStoreState ks vs d) (RealMonad IO ks vs d)
  where
  observeReal ::
    Proxy (RealMonad IO ks vs d) ->
    LockstepAction (BackingStoreState ks vs d) a ->
    Realized (RealMonad IO ks vs d) a ->
    BSObs ks vs d a
  observeReal :: forall a.
Proxy (RealMonad IO ks vs d)
-> LockstepAction (BackingStoreState ks vs d) a
-> Realized (RealMonad IO ks vs d) a
-> Observable (BackingStoreState ks vs d) a
observeReal Proxy (RealMonad IO ks vs d)
_proxy = \case
    BSInitFromValues WithOrigin SlotNo
_ InitHint vs
_ Values vs
_ -> Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a
Either (BSObs ks vs d Err) (BSObs ks vs d ())
-> BSObs ks vs d (Either Err ())
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a)
-> (Either Err () -> Either (BSObs ks vs d Err) (BSObs ks vs d ()))
-> Either Err ()
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (() -> BSObs ks vs d ())
-> Either Err ()
-> Either (BSObs ks vs d Err) (BSObs ks vs d ())
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId () -> BSObs ks vs d ()
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId
    BSInitFromCopy InitHint vs
_ FsPath
_ -> Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a
Either (BSObs ks vs d Err) (BSObs ks vs d ())
-> BSObs ks vs d (Either Err ())
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a)
-> (Either Err () -> Either (BSObs ks vs d Err) (BSObs ks vs d ()))
-> Either Err ()
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (() -> BSObs ks vs d ())
-> Either Err ()
-> Either (BSObs ks vs d Err) (BSObs ks vs d ())
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId () -> BSObs ks vs d ()
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId
    LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSClose -> Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a
Either (BSObs ks vs d Err) (BSObs ks vs d ())
-> BSObs ks vs d (Either Err ())
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a)
-> (Either Err () -> Either (BSObs ks vs d Err) (BSObs ks vs d ()))
-> Either Err ()
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (() -> BSObs ks vs d ())
-> Either Err ()
-> Either (BSObs ks vs d Err) (BSObs ks vs d ())
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId () -> BSObs ks vs d ()
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId
    BSCopy SerializeTablesHint vs
_ FsPath
_ -> Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a
Either (BSObs ks vs d Err) (BSObs ks vs d ())
-> BSObs ks vs d (Either Err ())
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a)
-> (Either Err () -> Either (BSObs ks vs d Err) (BSObs ks vs d ()))
-> Either Err ()
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (() -> BSObs ks vs d ())
-> Either Err ()
-> Either (BSObs ks vs d Err) (BSObs ks vs d ())
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId () -> BSObs ks vs d ()
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId
    LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSValueHandle -> Either
  (BSObs ks vs d Err)
  (BSObs ks vs d (BackingStoreValueHandle IO ks vs))
-> BSObs ks vs d a
Either
  (BSObs ks vs d Err)
  (BSObs ks vs d (BackingStoreValueHandle IO ks vs))
-> BSObs ks vs d (Either Err (BackingStoreValueHandle IO ks vs))
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either
   (BSObs ks vs d Err)
   (BSObs ks vs d (BackingStoreValueHandle IO ks vs))
 -> BSObs ks vs d a)
-> (Either Err (BackingStoreValueHandle IO ks vs)
    -> Either
         (BSObs ks vs d Err)
         (BSObs ks vs d (BackingStoreValueHandle IO ks vs)))
-> Either Err (BackingStoreValueHandle IO ks vs)
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (BackingStoreValueHandle IO ks vs
    -> BSObs ks vs d (BackingStoreValueHandle IO ks vs))
-> Either Err (BackingStoreValueHandle IO ks vs)
-> Either
     (BSObs ks vs d Err)
     (BSObs ks vs d (BackingStoreValueHandle IO ks vs))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId (BSObs ks vs d (BackingStoreValueHandle IO ks vs)
-> BackingStoreValueHandle IO ks vs
-> BSObs ks vs d (BackingStoreValueHandle IO ks vs)
forall a b. a -> b -> a
const BSObs ks vs d (BackingStoreValueHandle IO ks vs)
forall ks vs d. BSObs ks vs d (BackingStoreValueHandle IO ks vs)
OValueHandle)
    BSWrite SlotNo
_ WriteHint d
_ d
_ -> Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a
Either (BSObs ks vs d Err) (BSObs ks vs d ())
-> BSObs ks vs d (Either Err ())
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a)
-> (Either Err () -> Either (BSObs ks vs d Err) (BSObs ks vs d ()))
-> Either Err ()
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (() -> BSObs ks vs d ())
-> Either Err ()
-> Either (BSObs ks vs d Err) (BSObs ks vs d ())
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId () -> BSObs ks vs d ()
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId
    BSVHClose BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ -> Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a
Either (BSObs ks vs d Err) (BSObs ks vs d ())
-> BSObs ks vs d (Either Err ())
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d Err) (BSObs ks vs d ()) -> BSObs ks vs d a)
-> (Either Err () -> Either (BSObs ks vs d Err) (BSObs ks vs d ()))
-> Either Err ()
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (() -> BSObs ks vs d ())
-> Either Err ()
-> Either (BSObs ks vs d Err) (BSObs ks vs d ())
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId () -> BSObs ks vs d ()
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId
    BSVHRangeRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ ReadHint vs
_ RangeQuery ks
_ -> Either (BSObs ks vs d Err) (BSObs ks vs d (Values vs))
-> BSObs ks vs d a
Either (BSObs ks vs d Err) (BSObs ks vs d (Values vs))
-> BSObs ks vs d (Either Err (Values vs))
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d Err) (BSObs ks vs d (Values vs))
 -> BSObs ks vs d a)
-> (Either Err (Values vs)
    -> Either (BSObs ks vs d Err) (BSObs ks vs d (Values vs)))
-> Either Err (Values vs)
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (Values vs -> BSObs ks vs d (Values vs))
-> Either Err (Values vs)
-> Either (BSObs ks vs d Err) (BSObs ks vs d (Values vs))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId (vs -> BSObs ks vs d (Values vs)
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d (Values a)
OValues (vs -> BSObs ks vs d (Values vs))
-> (Values vs -> vs) -> Values vs -> BSObs ks vs d (Values vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values vs -> vs
forall vs. Values vs -> vs
unValues)
    BSVHRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ ReadHint vs
_ ks
_ -> Either (BSObs ks vs d Err) (BSObs ks vs d (Values vs))
-> BSObs ks vs d a
Either (BSObs ks vs d Err) (BSObs ks vs d (Values vs))
-> BSObs ks vs d (Either Err (Values vs))
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d Err) (BSObs ks vs d (Values vs))
 -> BSObs ks vs d a)
-> (Either Err (Values vs)
    -> Either (BSObs ks vs d Err) (BSObs ks vs d (Values vs)))
-> Either Err (Values vs)
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (Values vs -> BSObs ks vs d (Values vs))
-> Either Err (Values vs)
-> Either (BSObs ks vs d Err) (BSObs ks vs d (Values vs))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId (vs -> BSObs ks vs d (Values vs)
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d (Values a)
OValues (vs -> BSObs ks vs d (Values vs))
-> (Values vs -> vs) -> Values vs -> BSObs ks vs d (Values vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values vs -> vs
forall vs. Values vs -> vs
unValues)
    BSVHAtSlot BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ -> Either (BSObs ks vs d Err) (BSObs ks vs d (WithOrigin SlotNo))
-> BSObs ks vs d a
Either (BSObs ks vs d Err) (BSObs ks vs d (WithOrigin SlotNo))
-> BSObs ks vs d (Either Err (WithOrigin SlotNo))
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d Err) (BSObs ks vs d (WithOrigin SlotNo))
 -> BSObs ks vs d a)
-> (Either Err (WithOrigin SlotNo)
    -> Either (BSObs ks vs d Err) (BSObs ks vs d (WithOrigin SlotNo)))
-> Either Err (WithOrigin SlotNo)
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (WithOrigin SlotNo -> BSObs ks vs d (WithOrigin SlotNo))
-> Either Err (WithOrigin SlotNo)
-> Either (BSObs ks vs d Err) (BSObs ks vs d (WithOrigin SlotNo))
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId WithOrigin SlotNo -> BSObs ks vs d (WithOrigin SlotNo)
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId
    BSVHStat BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ -> Either (BSObs ks vs d Err) (BSObs ks vs d Statistics)
-> BSObs ks vs d a
Either (BSObs ks vs d Err) (BSObs ks vs d Statistics)
-> BSObs ks vs d (Either Err Statistics)
forall ks vs d a b.
Either (BSObs ks vs d a) (BSObs ks vs d b)
-> BSObs ks vs d (Either a b)
OEither (Either (BSObs ks vs d Err) (BSObs ks vs d Statistics)
 -> BSObs ks vs d a)
-> (Either Err Statistics
    -> Either (BSObs ks vs d Err) (BSObs ks vs d Statistics))
-> Either Err Statistics
-> BSObs ks vs d a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSObs ks vs d Err)
-> (Statistics -> BSObs ks vs d Statistics)
-> Either Err Statistics
-> Either (BSObs ks vs d Err) (BSObs ks vs d Statistics)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSObs ks vs d Err
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId Statistics -> BSObs ks vs d Statistics
forall a ks vs d.
(Show a, Eq a, Typeable a) =>
a -> BSObs ks vs d a
OId

  showRealResponse ::
    Proxy (RealMonad IO ks vs d) ->
    LockstepAction (BackingStoreState ks vs d) a ->
    Maybe (Dict (Show (Realized (RealMonad IO ks vs d) a)))
  showRealResponse :: forall a.
Proxy (RealMonad IO ks vs d)
-> LockstepAction (BackingStoreState ks vs d) a
-> Maybe (Dict (Show (Realized (RealMonad IO ks vs d) a)))
showRealResponse Proxy (RealMonad IO ks vs d)
_proxy = \case
    BSInitFromValues WithOrigin SlotNo
_ InitHint vs
_ Values vs
_ -> Dict (Show (Either Err ())) -> Maybe (Dict (Show (Either Err ())))
forall a. a -> Maybe a
Just Dict (Show (Either Err ()))
forall (a :: Constraint). a => Dict a
Dict
    BSInitFromCopy InitHint vs
_ FsPath
_ -> Dict (Show (Either Err ())) -> Maybe (Dict (Show (Either Err ())))
forall a. a -> Maybe a
Just Dict (Show (Either Err ()))
forall (a :: Constraint). a => Dict a
Dict
    LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSClose -> Dict (Show (Either Err ())) -> Maybe (Dict (Show (Either Err ())))
forall a. a -> Maybe a
Just Dict (Show (Either Err ()))
forall (a :: Constraint). a => Dict a
Dict
    BSCopy SerializeTablesHint vs
_ FsPath
_ -> Dict (Show (Either Err ())) -> Maybe (Dict (Show (Either Err ())))
forall a. a -> Maybe a
Just Dict (Show (Either Err ()))
forall (a :: Constraint). a => Dict a
Dict
    LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSValueHandle -> Maybe (Dict (Show (Either Err (BackingStoreValueHandle IO ks vs))))
Maybe (Dict (Show (Realized (RealMonad IO ks vs d) a)))
forall a. Maybe a
Nothing
    BSWrite SlotNo
_ WriteHint d
_ d
_ -> Dict (Show (Either Err ())) -> Maybe (Dict (Show (Either Err ())))
forall a. a -> Maybe a
Just Dict (Show (Either Err ()))
forall (a :: Constraint). a => Dict a
Dict
    BSVHClose BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ -> Dict (Show (Either Err ())) -> Maybe (Dict (Show (Either Err ())))
forall a. a -> Maybe a
Just Dict (Show (Either Err ()))
forall (a :: Constraint). a => Dict a
Dict
    BSVHRangeRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ ReadHint vs
_ RangeQuery ks
_ -> Dict (Show (Either Err (Values vs)))
-> Maybe (Dict (Show (Either Err (Values vs))))
forall a. a -> Maybe a
Just Dict (Show (Either Err (Values vs)))
forall (a :: Constraint). a => Dict a
Dict
    BSVHRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ ReadHint vs
_ ks
_ -> Dict (Show (Either Err (Values vs)))
-> Maybe (Dict (Show (Either Err (Values vs))))
forall a. a -> Maybe a
Just Dict (Show (Either Err (Values vs)))
forall (a :: Constraint). a => Dict a
Dict
    BSVHAtSlot BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ -> Dict (Show (Either Err (WithOrigin SlotNo)))
-> Maybe (Dict (Show (Either Err (WithOrigin SlotNo))))
forall a. a -> Maybe a
Just Dict (Show (Either Err (WithOrigin SlotNo)))
forall (a :: Constraint). a => Dict a
Dict
    BSVHStat BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ -> Dict (Show (Either Err Statistics))
-> Maybe (Dict (Show (Either Err Statistics)))
forall a. a -> Maybe a
Just Dict (Show (Either Err Statistics))
forall (a :: Constraint). a => Dict a
Dict

{-------------------------------------------------------------------------------
  Interpreter against the model
-------------------------------------------------------------------------------}

runMock ::
  forall ks vs d a.
  ( Mock.HasOps ks vs d
  , QC.Arbitrary ks
  , QC.Arbitrary vs
  , QC.Arbitrary d
  , QC.Arbitrary (BS.RangeQuery ks)
  ) =>
  ModelVarContext (BackingStoreState ks vs d) ->
  Action (Lockstep (BackingStoreState ks vs d)) a ->
  Mock vs ->
  ( BSVal ks vs d a
  , Mock vs
  )
runMock :: forall ks vs d a.
(HasOps ks vs d, Arbitrary ks, Arbitrary vs, Arbitrary d,
 Arbitrary (RangeQuery ks)) =>
ModelVarContext (BackingStoreState ks vs d)
-> Action (Lockstep (BackingStoreState ks vs d)) a
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
runMock ModelVarContext (BackingStoreState ks vs d)
lookUp = \case
  BSInitFromValues WithOrigin SlotNo
sl InitHint vs
h (Values vs
vs) ->
    (() -> BSVal ks vs d ())
-> (Either Err (), Mock vs)
-> (BSVal ks vs d (Either Err ()), Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap () -> BSVal ks vs d ()
forall ks vs d. () -> BSVal ks vs d ()
MUnit ((Either Err (), Mock vs) -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err (), Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any () -> Mock vs -> (Either Err (), Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad (WithOrigin SlotNo -> InitHint vs -> vs -> MockMonad Any vs Any ()
forall vs (m :: * -> *).
MonadState (Mock vs) m =>
WithOrigin SlotNo -> InitHint vs -> vs -> m ()
Mock.mBSInitFromValues WithOrigin SlotNo
sl InitHint vs
h vs
vs)
  BSInitFromCopy InitHint vs
h FsPath
bsp ->
    (() -> BSVal ks vs d ())
-> (Either Err (), Mock vs)
-> (BSVal ks vs d (Either Err ()), Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap () -> BSVal ks vs d ()
forall ks vs d. () -> BSVal ks vs d ()
MUnit ((Either Err (), Mock vs) -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err (), Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any () -> Mock vs -> (Either Err (), Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad (InitHint vs -> FsPath -> MockMonad Any vs Any ()
forall vs (m :: * -> *).
(MonadState (Mock vs) m, MonadError Err m) =>
InitHint vs -> FsPath -> m ()
Mock.mBSInitFromCopy InitHint vs
h FsPath
bsp)
  Action (Lockstep (BackingStoreState ks vs d)) a
R:ActionLockstepa ks vs d a
BSClose ->
    (() -> BSVal ks vs d ())
-> (Either Err (), Mock vs)
-> (BSVal ks vs d (Either Err ()), Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap () -> BSVal ks vs d ()
forall ks vs d. () -> BSVal ks vs d ()
MUnit ((Either Err (), Mock vs) -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err (), Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any () -> Mock vs -> (Either Err (), Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad MockMonad Any vs Any ()
forall vs (m :: * -> *). MonadState (Mock vs) m => m ()
Mock.mBSClose
  BSCopy SerializeTablesHint vs
h FsPath
bsp ->
    (() -> BSVal ks vs d ())
-> (Either Err (), Mock vs)
-> (BSVal ks vs d (Either Err ()), Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap () -> BSVal ks vs d ()
forall ks vs d. () -> BSVal ks vs d ()
MUnit ((Either Err (), Mock vs) -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err (), Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any () -> Mock vs -> (Either Err (), Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad (SerializeTablesHint vs -> FsPath -> MockMonad Any vs Any ()
forall vs (m :: * -> *).
(MonadState (Mock vs) m, MonadError Err m) =>
SerializeTablesHint vs -> FsPath -> m ()
Mock.mBSCopy SerializeTablesHint vs
h FsPath
bsp)
  Action (Lockstep (BackingStoreState ks vs d)) a
R:ActionLockstepa ks vs d a
BSValueHandle ->
    (ValueHandle vs
 -> BSVal ks vs d (BackingStoreValueHandle IO ks vs))
-> (Either Err (ValueHandle vs), Mock vs)
-> (BSVal ks vs d (Either Err (BackingStoreValueHandle IO ks vs)),
    Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap ValueHandle vs -> BSVal ks vs d (BackingStoreValueHandle IO ks vs)
forall vs ks d.
ValueHandle vs -> BSVal ks vs d (BackingStoreValueHandle IO ks vs)
MValueHandle ((Either Err (ValueHandle vs), Mock vs)
 -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err (ValueHandle vs), Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any (ValueHandle vs)
-> Mock vs -> (Either Err (ValueHandle vs), Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad MockMonad Any vs Any (ValueHandle vs)
forall vs (m :: * -> *).
(MonadState (Mock vs) m, MonadError Err m) =>
m (ValueHandle vs)
Mock.mBSValueHandle
  BSWrite SlotNo
sl WriteHint d
whint d
d ->
    (() -> BSVal ks vs d ())
-> (Either Err (), Mock vs)
-> (BSVal ks vs d (Either Err ()), Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap () -> BSVal ks vs d ()
forall ks vs d. () -> BSVal ks vs d ()
MUnit ((Either Err (), Mock vs) -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err (), Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any () -> Mock vs -> (Either Err (), Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad (SlotNo -> WriteHint d -> d -> MockMonad Any vs Any ()
forall vs (m :: * -> *) d.
(MonadState (Mock vs) m, MonadError Err m, ApplyDiff vs d) =>
SlotNo -> WriteHint d -> d -> m ()
Mock.mBSWrite SlotNo
sl WriteHint d
whint d
d)
  BSVHClose BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ->
    (() -> BSVal ks vs d ())
-> (Either Err (), Mock vs)
-> (BSVal ks vs d (Either Err ()), Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap () -> BSVal ks vs d ()
forall ks vs d. () -> BSVal ks vs d ()
MUnit ((Either Err (), Mock vs) -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err (), Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any () -> Mock vs -> (Either Err (), Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad (ValueHandle vs -> MockMonad Any vs Any ()
forall vs (m :: * -> *).
MonadState (Mock vs) m =>
ValueHandle vs -> m ()
Mock.mBSVHClose (BSVal ks vs d (BackingStoreValueHandle IO ks vs) -> ValueHandle vs
getHandle (BSVal ks vs d (BackingStoreValueHandle IO ks vs)
 -> ValueHandle vs)
-> BSVal ks vs d (BackingStoreValueHandle IO ks vs)
-> ValueHandle vs
forall a b. (a -> b) -> a -> b
$ ModelVarContext (BackingStoreState ks vs d)
-> ModelLookUp (BackingStoreState ks vs d)
forall state.
InLockstep state =>
ModelVarContext state -> ModelLookUp state
lookupVar ModelVarContext (BackingStoreState ks vs d)
lookUp BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h))
  BSVHRangeRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ReadHint vs
rhint RangeQuery ks
rq ->
    (vs -> BSVal ks vs d (Values vs))
-> (Either Err vs, Mock vs)
-> (BSVal ks vs d (Either Err (Values vs)), Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap vs -> BSVal ks vs d (Values vs)
forall vs ks d. vs -> BSVal ks vs d (Values vs)
MValues ((Either Err vs, Mock vs) -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err vs, Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any vs -> Mock vs -> (Either Err vs, Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad (ValueHandle vs
-> ReadHint vs -> RangeQuery ks -> MockMonad Any vs Any vs
forall vs (m :: * -> *) ks.
(MonadState (Mock vs) m, MonadError Err m,
 LookupKeysRange ks vs) =>
ValueHandle vs -> ReadHint vs -> RangeQuery ks -> m vs
Mock.mBSVHRangeRead (BSVal ks vs d (BackingStoreValueHandle IO ks vs) -> ValueHandle vs
getHandle (BSVal ks vs d (BackingStoreValueHandle IO ks vs)
 -> ValueHandle vs)
-> BSVal ks vs d (BackingStoreValueHandle IO ks vs)
-> ValueHandle vs
forall a b. (a -> b) -> a -> b
$ ModelVarContext (BackingStoreState ks vs d)
-> ModelLookUp (BackingStoreState ks vs d)
forall state.
InLockstep state =>
ModelVarContext state -> ModelLookUp state
lookupVar ModelVarContext (BackingStoreState ks vs d)
lookUp BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h) ReadHint vs
rhint RangeQuery ks
rq)
  BSVHRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ReadHint vs
rhint ks
ks ->
    (vs -> BSVal ks vs d (Values vs))
-> (Either Err vs, Mock vs)
-> (BSVal ks vs d (Either Err (Values vs)), Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap vs -> BSVal ks vs d (Values vs)
forall vs ks d. vs -> BSVal ks vs d (Values vs)
MValues ((Either Err vs, Mock vs) -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err vs, Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any vs -> Mock vs -> (Either Err vs, Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad (ValueHandle vs -> ReadHint vs -> ks -> MockMonad Any vs Any vs
forall vs (m :: * -> *) ks.
(MonadState (Mock vs) m, MonadError Err m, LookupKeys ks vs) =>
ValueHandle vs -> ReadHint vs -> ks -> m vs
Mock.mBSVHRead (BSVal ks vs d (BackingStoreValueHandle IO ks vs) -> ValueHandle vs
getHandle (BSVal ks vs d (BackingStoreValueHandle IO ks vs)
 -> ValueHandle vs)
-> BSVal ks vs d (BackingStoreValueHandle IO ks vs)
-> ValueHandle vs
forall a b. (a -> b) -> a -> b
$ ModelVarContext (BackingStoreState ks vs d)
-> ModelLookUp (BackingStoreState ks vs d)
forall state.
InLockstep state =>
ModelVarContext state -> ModelLookUp state
lookupVar ModelVarContext (BackingStoreState ks vs d)
lookUp BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h) ReadHint vs
rhint ks
ks)
  BSVHAtSlot BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ->
    (WithOrigin SlotNo -> BSVal ks vs d (WithOrigin SlotNo))
-> (Either Err (WithOrigin SlotNo), Mock vs)
-> (BSVal ks vs d (Either Err (WithOrigin SlotNo)), Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap WithOrigin SlotNo -> BSVal ks vs d (WithOrigin SlotNo)
forall ks vs d.
WithOrigin SlotNo -> BSVal ks vs d (WithOrigin SlotNo)
MSlotNo ((Either Err (WithOrigin SlotNo), Mock vs)
 -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err (WithOrigin SlotNo), Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any (WithOrigin SlotNo)
-> Mock vs -> (Either Err (WithOrigin SlotNo), Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad (ValueHandle vs -> MockMonad Any vs Any (WithOrigin SlotNo)
forall (m :: * -> *) vs.
Monad m =>
ValueHandle vs -> m (WithOrigin SlotNo)
Mock.mBSVHAtSlot (BSVal ks vs d (BackingStoreValueHandle IO ks vs) -> ValueHandle vs
getHandle (BSVal ks vs d (BackingStoreValueHandle IO ks vs)
 -> ValueHandle vs)
-> BSVal ks vs d (BackingStoreValueHandle IO ks vs)
-> ValueHandle vs
forall a b. (a -> b) -> a -> b
$ ModelVarContext (BackingStoreState ks vs d)
-> ModelLookUp (BackingStoreState ks vs d)
forall state.
InLockstep state =>
ModelVarContext state -> ModelLookUp state
lookupVar ModelVarContext (BackingStoreState ks vs d)
lookUp BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h))
  BSVHStat BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ->
    (Statistics -> BSVal ks vs d Statistics)
-> (Either Err Statistics, Mock vs)
-> (BSVal ks vs d (Either Err Statistics), Mock vs)
forall {p :: * -> * -> *} {c} {ks} {vs} {d} {b} {c}.
Bifunctor p =>
(c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap Statistics -> BSVal ks vs d Statistics
forall ks vs d. Statistics -> BSVal ks vs d Statistics
MStatistics ((Either Err Statistics, Mock vs) -> (BSVal ks vs d a, Mock vs))
-> (Mock vs -> (Either Err Statistics, Mock vs))
-> Mock vs
-> (BSVal ks vs d a, Mock vs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MockMonad Any vs Any Statistics
-> Mock vs -> (Either Err Statistics, Mock vs)
forall ks vs d a.
MockMonad ks vs d a -> Mock vs -> (Either Err a, Mock vs)
runMockMonad (ValueHandle vs -> MockMonad Any vs Any Statistics
forall vs (m :: * -> *).
(MonadState (Mock vs) m, MonadError Err m, ValuesLength vs) =>
ValueHandle vs -> m Statistics
Mock.mBSVHStat (BSVal ks vs d (BackingStoreValueHandle IO ks vs) -> ValueHandle vs
getHandle (BSVal ks vs d (BackingStoreValueHandle IO ks vs)
 -> ValueHandle vs)
-> BSVal ks vs d (BackingStoreValueHandle IO ks vs)
-> ValueHandle vs
forall a b. (a -> b) -> a -> b
$ ModelVarContext (BackingStoreState ks vs d)
-> ModelLookUp (BackingStoreState ks vs d)
forall state.
InLockstep state =>
ModelVarContext state -> ModelLookUp state
lookupVar ModelVarContext (BackingStoreState ks vs d)
lookUp BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h))
 where
  wrap :: (c -> BSVal ks vs d b)
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) c
wrap c -> BSVal ks vs d b
f = (Either Err c -> BSVal ks vs d (Either Err b))
-> p (Either Err c) c -> p (BSVal ks vs d (Either Err b)) 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 (Either (BSVal ks vs d Err) (BSVal ks vs d b)
-> BSVal ks vs d (Either Err b)
forall ks vs d a b.
Either (BSVal ks vs d a) (BSVal ks vs d b)
-> BSVal ks vs d (Either a b)
MEither (Either (BSVal ks vs d Err) (BSVal ks vs d b)
 -> BSVal ks vs d (Either Err b))
-> (Either Err c -> Either (BSVal ks vs d Err) (BSVal ks vs d b))
-> Either Err c
-> BSVal ks vs d (Either Err b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Err -> BSVal ks vs d Err)
-> (c -> BSVal ks vs d b)
-> Either Err c
-> Either (BSVal ks vs d Err) (BSVal ks vs d b)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap Err -> BSVal ks vs d Err
forall ks vs d. Err -> BSVal ks vs d Err
MErr c -> BSVal ks vs d b
f)

  getHandle :: BSVal ks vs d (BS.BackingStoreValueHandle IO ks vs) -> ValueHandle vs
  getHandle :: BSVal ks vs d (BackingStoreValueHandle IO ks vs) -> ValueHandle vs
getHandle (MValueHandle ValueHandle vs
h) = ValueHandle vs
h

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

arbitraryBackingStoreAction ::
  forall ks vs d.
  ( Mock.HasOps ks vs d
  , QC.Arbitrary ks
  , QC.Arbitrary vs
  , QC.Arbitrary d
  , QC.Arbitrary (BS.RangeQuery ks)
  ) =>
  ModelVarContext (BackingStoreState ks vs d) ->
  BackingStoreState ks vs d ->
  Gen (Any (LockstepAction (BackingStoreState ks vs d)))
arbitraryBackingStoreAction :: forall ks vs d.
(HasOps ks vs d, Arbitrary ks, Arbitrary vs, Arbitrary d,
 Arbitrary (RangeQuery ks)) =>
ModelVarContext (BackingStoreState ks vs d)
-> BackingStoreState ks vs d
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
arbitraryBackingStoreAction ModelVarContext (BackingStoreState ks vs d)
fv (BackingStoreState Mock vs
mock Stats ks vs d
_stats) =
  [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency ([(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$
    [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
withoutVars
      [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
-> [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
-> [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
forall a. [a] -> [a] -> [a]
++ case ModelVarContext (BackingStoreState ks vs d)
-> ModelFindVariables (BackingStoreState ks vs d)
forall state.
InLockstep state =>
ModelVarContext state -> ModelFindVariables state
findVars ModelVarContext (BackingStoreState ks vs d)
fv (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(Either Err (BS.BackingStoreValueHandle IO ks vs))) of
        [] -> []
        [GVar
   (ModelOp (BackingStoreState ks vs d))
   (Either Err (BackingStoreValueHandle IO ks vs))]
vars -> Gen
  (GVar
     (ModelOp (BackingStoreState ks vs d))
     (Either Err (BackingStoreValueHandle IO ks vs)))
-> [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
withVars ([GVar Op (Either Err (BackingStoreValueHandle IO ks vs))]
-> Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
forall a. HasCallStack => [a] -> Gen a
QC.elements [GVar
   (ModelOp (BackingStoreState ks vs d))
   (Either Err (BackingStoreValueHandle IO ks vs))]
[GVar Op (Either Err (BackingStoreValueHandle IO ks vs))]
vars)
 where
  withoutVars :: [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
  withoutVars :: [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
withoutVars =
    [
      ( Int
5
      , (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Gen
   (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$
          WithOrigin SlotNo
-> InitHint vs
-> Values vs
-> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
forall vs ks d.
WithOrigin SlotNo -> InitHint vs -> Values vs -> BSAct ks vs d ()
BSInitFromValues
            (WithOrigin SlotNo
 -> InitHint vs
 -> Values vs
 -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (WithOrigin SlotNo)
-> Gen
     (InitHint vs
      -> Values vs
      -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (WithOrigin SlotNo)
forall a. Arbitrary a => Gen a
QC.arbitrary
            Gen
  (InitHint vs
   -> Values vs
   -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (InitHint vs)
-> Gen
     (Values vs
      -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> InitHint vs -> Gen (InitHint vs)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proxy vs -> InitHint vs
forall vs. MakeInitHint vs => Proxy vs -> InitHint vs
Mock.makeInitHint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @vs))
            Gen
  (Values vs
   -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Values vs)
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (vs -> Values vs
forall vs. vs -> Values vs
Values (vs -> Values vs) -> Gen vs -> Gen (Values vs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen vs
forall a. Arbitrary a => Gen a
QC.arbitrary)
      )
    ,
      ( Int
5
      , (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Gen
   (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$
          InitHint vs
-> FsPath
-> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
forall vs ks d. InitHint vs -> FsPath -> BSAct ks vs d ()
BSInitFromCopy
            (InitHint vs
 -> FsPath
 -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (InitHint vs)
-> Gen
     (FsPath
      -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InitHint vs -> Gen (InitHint vs)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proxy vs -> InitHint vs
forall vs. MakeInitHint vs => Proxy vs -> InitHint vs
Mock.makeInitHint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @vs))
            Gen
  (FsPath
   -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen FsPath
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen FsPath
genBackingStorePath
      )
    , (Int
2, Any (LockstepAction (BackingStoreState ks vs d))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Any (LockstepAction (BackingStoreState ks vs d))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Any (LockstepAction (BackingStoreState ks vs d))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$ Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
forall ks vs d. BSAct ks vs d ()
BSClose)
    , (Int
5, (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Gen
   (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$ SerializeTablesHint vs
-> FsPath
-> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
forall vs ks d.
SerializeTablesHint vs -> FsPath -> BSAct ks vs d ()
BSCopy (SerializeTablesHint vs
 -> FsPath
 -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (SerializeTablesHint vs)
-> Gen
     (FsPath
      -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SerializeTablesHint vs -> Gen (SerializeTablesHint vs)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proxy vs -> SerializeTablesHint vs
forall vs.
MakeSerializeTablesHint vs =>
Proxy vs -> SerializeTablesHint vs
Mock.makeSerializeTablesHint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @vs)) Gen
  (FsPath
   -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen FsPath
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen FsPath
genBackingStorePath)
    , (Int
5, Any (LockstepAction (BackingStoreState ks vs d))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Any (LockstepAction (BackingStoreState ks vs d))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Any (LockstepAction (BackingStoreState ks vs d))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$ Action
  (Lockstep (BackingStoreState ks vs d))
  (Either Err (BackingStoreValueHandle IO ks vs))
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some Action
  (Lockstep (BackingStoreState ks vs d))
  (Either Err (BackingStoreValueHandle IO ks vs))
forall ks vs d. BSAct ks vs d (BackingStoreValueHandle IO ks vs)
BSValueHandle)
    ,
      ( Int
5
      , (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Gen
   (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$
          SlotNo
-> WriteHint d
-> d
-> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
forall d ks vs. SlotNo -> WriteHint d -> d -> BSAct ks vs d ()
BSWrite
            (SlotNo
 -> WriteHint d
 -> d
 -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen SlotNo
-> Gen
     (WriteHint d
      -> d
      -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
genSlotNo
            Gen
  (WriteHint d
   -> d
   -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (WriteHint d)
-> Gen
     (d
      -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> WriteHint d -> Gen (WriteHint d)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proxy d -> WriteHint d
forall d. MakeWriteHint d => Proxy d -> WriteHint d
Mock.makeWriteHint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @d))
            Gen
  (d
   -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen d
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen d
genDiff
      )
    ]

  withVars ::
    Gen (BSVar ks vs d (Either Err (BS.BackingStoreValueHandle IO ks vs))) ->
    [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
  withVars :: Gen
  (GVar
     (ModelOp (BackingStoreState ks vs d))
     (Either Err (BackingStoreValueHandle IO ks vs)))
-> [(Int, Gen (Any (LockstepAction (BackingStoreState ks vs d))))]
withVars Gen
  (GVar
     (ModelOp (BackingStoreState ks vs d))
     (Either Err (BackingStoreValueHandle IO ks vs)))
genVar =
    [ (Int
5, (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Gen
   (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$ BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
GVar Op (BackingStoreValueHandle IO ks vs)
-> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
forall ks vs d.
BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> BSAct ks vs d ()
BSVHClose (GVar Op (BackingStoreValueHandle IO ks vs)
 -> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
-> Gen (GVar Op (BackingStoreValueHandle IO ks vs))
-> Gen
     (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ()))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GVar Op (Either Err (BackingStoreValueHandle IO ks vs))
-> GVar Op (BackingStoreValueHandle IO ks vs)
forall a. GVar Op (Either Err a) -> GVar Op a
opFromRight (GVar Op (Either Err (BackingStoreValueHandle IO ks vs))
 -> GVar Op (BackingStoreValueHandle IO ks vs))
-> Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
-> Gen (GVar Op (BackingStoreValueHandle IO ks vs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen
  (GVar
     (ModelOp (BackingStoreState ks vs d))
     (Either Err (BackingStoreValueHandle IO ks vs)))
Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
genVar))
    ,
      ( Int
5
      , (Action
   (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action
  (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Gen
   (Action
      (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$
          BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> ReadHint vs
-> RangeQuery ks
-> Action
     (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
GVar Op (BackingStoreValueHandle IO ks vs)
-> ReadHint vs
-> RangeQuery ks
-> Action
     (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
forall ks vs d.
BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> ReadHint vs -> RangeQuery ks -> BSAct ks vs d (Values vs)
BSVHRangeRead
            (GVar Op (BackingStoreValueHandle IO ks vs)
 -> ReadHint vs
 -> RangeQuery ks
 -> Action
      (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
-> Gen (GVar Op (BackingStoreValueHandle IO ks vs))
-> Gen
     (ReadHint vs
      -> RangeQuery ks
      -> Action
           (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GVar Op (Either Err (BackingStoreValueHandle IO ks vs))
-> GVar Op (BackingStoreValueHandle IO ks vs)
forall a. GVar Op (Either Err a) -> GVar Op a
opFromRight (GVar Op (Either Err (BackingStoreValueHandle IO ks vs))
 -> GVar Op (BackingStoreValueHandle IO ks vs))
-> Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
-> Gen (GVar Op (BackingStoreValueHandle IO ks vs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen
  (GVar
     (ModelOp (BackingStoreState ks vs d))
     (Either Err (BackingStoreValueHandle IO ks vs)))
Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
genVar)
            Gen
  (ReadHint vs
   -> RangeQuery ks
   -> Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
-> Gen (ReadHint vs)
-> Gen
     (RangeQuery ks
      -> Action
           (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadHint vs -> Gen (ReadHint vs)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proxy vs -> ReadHint vs
forall vs. MakeReadHint vs => Proxy vs -> ReadHint vs
Mock.makeReadHint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @vs))
            Gen
  (RangeQuery ks
   -> Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
-> Gen (RangeQuery ks)
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (RangeQuery ks)
forall a. Arbitrary a => Gen a
QC.arbitrary
      )
    ,
      ( Int
5
      , (Action
   (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action
  (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Gen
   (Action
      (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$
          BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> ReadHint vs
-> ks
-> Action
     (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
GVar Op (BackingStoreValueHandle IO ks vs)
-> ReadHint vs
-> ks
-> Action
     (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
forall ks vs d.
BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> ReadHint vs -> ks -> BSAct ks vs d (Values vs)
BSVHRead
            (GVar Op (BackingStoreValueHandle IO ks vs)
 -> ReadHint vs
 -> ks
 -> Action
      (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
-> Gen (GVar Op (BackingStoreValueHandle IO ks vs))
-> Gen
     (ReadHint vs
      -> ks
      -> Action
           (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GVar Op (Either Err (BackingStoreValueHandle IO ks vs))
-> GVar Op (BackingStoreValueHandle IO ks vs)
forall a. GVar Op (Either Err a) -> GVar Op a
opFromRight (GVar Op (Either Err (BackingStoreValueHandle IO ks vs))
 -> GVar Op (BackingStoreValueHandle IO ks vs))
-> Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
-> Gen (GVar Op (BackingStoreValueHandle IO ks vs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen
  (GVar
     (ModelOp (BackingStoreState ks vs d))
     (Either Err (BackingStoreValueHandle IO ks vs)))
Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
genVar)
            Gen
  (ReadHint vs
   -> ks
   -> Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
-> Gen (ReadHint vs)
-> Gen
     (ks
      -> Action
           (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadHint vs -> Gen (ReadHint vs)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proxy vs -> ReadHint vs
forall vs. MakeReadHint vs => Proxy vs -> ReadHint vs
Mock.makeReadHint (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @vs))
            Gen
  (ks
   -> Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
-> Gen ks
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs)))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ks
forall a. Arbitrary a => Gen a
QC.arbitrary
      )
    , (Int
5, (Action
   (Lockstep (BackingStoreState ks vs d))
   (Either Err (WithOrigin SlotNo))
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d))
        (Either Err (WithOrigin SlotNo)))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action
  (Lockstep (BackingStoreState ks vs d))
  (Either Err (WithOrigin SlotNo))
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Gen
   (Action
      (Lockstep (BackingStoreState ks vs d))
      (Either Err (WithOrigin SlotNo)))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d))
        (Either Err (WithOrigin SlotNo)))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$ BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> Action
     (Lockstep (BackingStoreState ks vs d))
     (Either Err (WithOrigin SlotNo))
GVar Op (BackingStoreValueHandle IO ks vs)
-> Action
     (Lockstep (BackingStoreState ks vs d))
     (Either Err (WithOrigin SlotNo))
forall ks vs d.
BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> BSAct ks vs d (WithOrigin SlotNo)
BSVHAtSlot (GVar Op (BackingStoreValueHandle IO ks vs)
 -> Action
      (Lockstep (BackingStoreState ks vs d))
      (Either Err (WithOrigin SlotNo)))
-> Gen (GVar Op (BackingStoreValueHandle IO ks vs))
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d))
        (Either Err (WithOrigin SlotNo)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GVar Op (Either Err (BackingStoreValueHandle IO ks vs))
-> GVar Op (BackingStoreValueHandle IO ks vs)
forall a. GVar Op (Either Err a) -> GVar Op a
opFromRight (GVar Op (Either Err (BackingStoreValueHandle IO ks vs))
 -> GVar Op (BackingStoreValueHandle IO ks vs))
-> Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
-> Gen (GVar Op (BackingStoreValueHandle IO ks vs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen
  (GVar
     (ModelOp (BackingStoreState ks vs d))
     (Either Err (BackingStoreValueHandle IO ks vs)))
Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
genVar))
    , (Int
5, (Action
   (Lockstep (BackingStoreState ks vs d)) (Either Err Statistics)
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err Statistics))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Action
  (Lockstep (BackingStoreState ks vs d)) (Either Err Statistics)
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Gen
   (Action
      (Lockstep (BackingStoreState ks vs d)) (Either Err Statistics))
 -> Gen (Any (LockstepAction (BackingStoreState ks vs d))))
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err Statistics))
-> Gen (Any (LockstepAction (BackingStoreState ks vs d)))
forall a b. (a -> b) -> a -> b
$ BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> Action
     (Lockstep (BackingStoreState ks vs d)) (Either Err Statistics)
GVar Op (BackingStoreValueHandle IO ks vs)
-> Action
     (Lockstep (BackingStoreState ks vs d)) (Either Err Statistics)
forall ks vs d.
BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> BSAct ks vs d Statistics
BSVHStat (GVar Op (BackingStoreValueHandle IO ks vs)
 -> Action
      (Lockstep (BackingStoreState ks vs d)) (Either Err Statistics))
-> Gen (GVar Op (BackingStoreValueHandle IO ks vs))
-> Gen
     (Action
        (Lockstep (BackingStoreState ks vs d)) (Either Err Statistics))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (GVar Op (Either Err (BackingStoreValueHandle IO ks vs))
-> GVar Op (BackingStoreValueHandle IO ks vs)
forall a. GVar Op (Either Err a) -> GVar Op a
opFromRight (GVar Op (Either Err (BackingStoreValueHandle IO ks vs))
 -> GVar Op (BackingStoreValueHandle IO ks vs))
-> Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
-> Gen (GVar Op (BackingStoreValueHandle IO ks vs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen
  (GVar
     (ModelOp (BackingStoreState ks vs d))
     (Either Err (BackingStoreValueHandle IO ks vs)))
Gen (GVar Op (Either Err (BackingStoreValueHandle IO ks vs)))
genVar))
    ]
   where
    opFromRight :: forall a. GVar Op (Either Err a) -> GVar Op a
    opFromRight :: forall a. GVar Op (Either Err a) -> GVar Op a
opFromRight = (forall x. Op x (Either Err a) -> Op x a)
-> GVar Op (Either Err a) -> GVar Op a
forall (op :: * -> * -> *) a b.
(forall x. op x a -> op x b) -> GVar op a -> GVar op b
mapGVar (\Op x (Either Err a)
op -> Op (Either Err a) a
forall b1 b. Op (Either b1 b) b
OpRight Op (Either Err a) a -> Op x (Either Err a) -> Op x a
forall b1 b a. Op b1 b -> Op a b1 -> Op a b
`OpComp` Op x (Either Err a)
op)

  genBackingStorePath :: Gen FS.FsPath
  genBackingStorePath :: Gen FsPath
genBackingStorePath = do
    file <- Gen String
genBSPFile
    pure . mkFsPath $ ["copies", file]

  -- Generate a file name for a copy of the backing store contents. We keep
  -- the set of possible file names small, such that errors (i.e., file alread
  -- exists) occur most of the time.
  genBSPFile :: Gen String
  genBSPFile :: Gen String
genBSPFile = [String] -> Gen String
forall a. HasCallStack => [a] -> Gen a
QC.elements [Int -> String
forall a. Show a => a -> String
show Int
x | Int
x <- [Int
1 :: Int .. Int
10]]

  -- Generate a slot number that is close before, at, or after the backing
  -- store's current slot number. A
  genSlotNo :: Gen SlotNo
  genSlotNo :: Gen SlotNo
genSlotNo = do
    n :: Int <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (-Int
5, Int
5)
    pure $ maybe 0 (+ fromIntegral n) (withOriginToMaybe seqNo)
   where
    seqNo :: WithOrigin SlotNo
seqNo = Mock vs -> WithOrigin SlotNo
forall vs. Mock vs -> WithOrigin SlotNo
backingSeqNo Mock vs
mock

  -- Generate valid diffs most of the time, and generate fully arbitrary
  -- (probably invalid) diffs some of the time.
  genDiff :: Gen d
  genDiff :: Gen d
genDiff =
    [(Int, Gen d)] -> Gen d
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
      [ (Int
9, vs -> vs -> d
forall vs d. MakeDiff vs d => vs -> vs -> d
Mock.diff (Mock vs -> vs
forall vs. Mock vs -> vs
backingValues Mock vs
mock) (vs -> d) -> Gen vs -> Gen d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen vs
forall a. Arbitrary a => Gen a
QC.arbitrary)
      , (Int
1, Gen d
forall a. Arbitrary a => Gen a
QC.arbitrary)
      ]

{-------------------------------------------------------------------------------
  Shrinker
-------------------------------------------------------------------------------}

shrinkBackingStoreAction ::
  forall ks vs d a.
  ( Typeable vs
  , Eq ks
  , Eq vs
  , Eq d
  , Eq (BS.InitHint vs)
  , Eq (BS.WriteHint d)
  , Eq (BS.ReadHint vs)
  , Eq (SerializeTablesHint vs)
  , QC.Arbitrary d
  , QC.Arbitrary (BS.RangeQuery ks)
  , QC.Arbitrary ks
  ) =>
  ModelVarContext (BackingStoreState ks vs d) ->
  BackingStoreState ks vs d ->
  LockstepAction (BackingStoreState ks vs d) a ->
  [Any (LockstepAction (BackingStoreState ks vs d))]
shrinkBackingStoreAction :: forall ks vs d a.
(Typeable vs, Eq ks, Eq vs, Eq d, Eq (InitHint vs),
 Eq (WriteHint d), Eq (ReadHint vs), Eq (SerializeTablesHint vs),
 Arbitrary d, Arbitrary (RangeQuery ks), Arbitrary ks) =>
ModelVarContext (BackingStoreState ks vs d)
-> BackingStoreState ks vs d
-> LockstepAction (BackingStoreState ks vs d) a
-> [Any (LockstepAction (BackingStoreState ks vs d))]
shrinkBackingStoreAction ModelVarContext (BackingStoreState ks vs d)
_findVars (BackingStoreState Mock vs
_mock Stats ks vs d
_) = \case
  BSWrite SlotNo
sl WriteHint d
st d
d ->
    [Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a b. (a -> b) -> a -> b
$ SlotNo
-> WriteHint d
-> d
-> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
forall d ks vs. SlotNo -> WriteHint d -> d -> BSAct ks vs d ()
BSWrite SlotNo
sl WriteHint d
st d
d' | d
d' <- d -> [d]
forall a. Arbitrary a => a -> [a]
QC.shrink d
d]
      [Any (LockstepAction (BackingStoreState ks vs d))]
-> [Any (LockstepAction (BackingStoreState ks vs d))]
-> [Any (LockstepAction (BackingStoreState ks vs d))]
forall a. [a] -> [a] -> [a]
++ [Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a b. (a -> b) -> a -> b
$ SlotNo
-> WriteHint d
-> d
-> Action (Lockstep (BackingStoreState ks vs d)) (Either Err ())
forall d ks vs. SlotNo -> WriteHint d -> d -> BSAct ks vs d ()
BSWrite SlotNo
sl' WriteHint d
st d
d | SlotNo
sl' <- SlotNo -> [SlotNo]
forall a. Arbitrary a => a -> [a]
QC.shrink SlotNo
sl]
  BSVHRangeRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ReadHint vs
rhint RangeQuery ks
rq ->
    [Action
  (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Action
   (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Action
     (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a b. (a -> b) -> a -> b
$ BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> ReadHint vs
-> RangeQuery ks
-> Action
     (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
forall ks vs d.
BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> ReadHint vs -> RangeQuery ks -> BSAct ks vs d (Values vs)
BSVHRangeRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ReadHint vs
rhint RangeQuery ks
rq' | RangeQuery ks
rq' <- RangeQuery ks -> [RangeQuery ks]
forall a. Arbitrary a => a -> [a]
QC.shrink RangeQuery ks
rq]
  BSVHRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ReadHint vs
rhint ks
ks ->
    [Action
  (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a (f :: * -> *). (Typeable a, Eq (f a)) => f a -> Any f
Some (Action
   (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
 -> Any (LockstepAction (BackingStoreState ks vs d)))
-> Action
     (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
-> Any (LockstepAction (BackingStoreState ks vs d))
forall a b. (a -> b) -> a -> b
$ BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> ReadHint vs
-> ks
-> Action
     (Lockstep (BackingStoreState ks vs d)) (Either Err (Values vs))
forall ks vs d.
BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> ReadHint vs -> ks -> BSAct ks vs d (Values vs)
BSVHRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ReadHint vs
rhint ks
ks' | ks
ks' <- ks -> [ks]
forall a. Arbitrary a => a -> [a]
QC.shrink ks
ks]
  LockstepAction (BackingStoreState ks vs d) a
_ -> []

{-------------------------------------------------------------------------------
  Interpret @'Op'@ against @'ModelValue'@
-------------------------------------------------------------------------------}

instance InterpretOp Op (ModelValue (BackingStoreState ks vs d)) where
  intOp :: forall a b.
Op a b
-> ModelValue (BackingStoreState ks vs d) a
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
intOp Op a b
OpId = ModelValue (BackingStoreState ks vs d) a
-> Maybe (ModelValue (BackingStoreState ks vs d) a)
ModelValue (BackingStoreState ks vs d) a
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a. a -> Maybe a
Just
  intOp Op a b
OpFst = \case MPair (BSVal ks vs d a, BSVal ks vs d b)
x -> ModelValue (BackingStoreState ks vs d) b
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a. a -> Maybe a
Just ((ModelValue (BackingStoreState ks vs d) b, BSVal ks vs d b)
-> ModelValue (BackingStoreState ks vs d) b
forall a b. (a, b) -> a
fst (ModelValue (BackingStoreState ks vs d) b, BSVal ks vs d b)
(BSVal ks vs d a, BSVal ks vs d b)
x)
  intOp Op a b
OpSnd = \case MPair (BSVal ks vs d a, BSVal ks vs d b)
x -> ModelValue (BackingStoreState ks vs d) b
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a. a -> Maybe a
Just ((BSVal ks vs d a, ModelValue (BackingStoreState ks vs d) b)
-> ModelValue (BackingStoreState ks vs d) b
forall a b. (a, b) -> b
snd (BSVal ks vs d a, ModelValue (BackingStoreState ks vs d) b)
(BSVal ks vs d a, BSVal ks vs d b)
x)
  intOp Op a b
OpLeft = \case MEither Either (BSVal ks vs d a) (BSVal ks vs d b)
x -> (ModelValue (BackingStoreState ks vs d) b
 -> Maybe (ModelValue (BackingStoreState ks vs d) b))
-> (BSVal ks vs d b
    -> Maybe (ModelValue (BackingStoreState ks vs d) b))
-> Either
     (ModelValue (BackingStoreState ks vs d) b) (BSVal ks vs d b)
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ModelValue (BackingStoreState ks vs d) b
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a. a -> Maybe a
Just (Maybe (ModelValue (BackingStoreState ks vs d) b)
-> BSVal ks vs d b
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a b. a -> b -> a
const Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a. Maybe a
Nothing) Either (ModelValue (BackingStoreState ks vs d) b) (BSVal ks vs d b)
Either (BSVal ks vs d a) (BSVal ks vs d b)
x
  intOp Op a b
OpRight = \case MEither Either (BSVal ks vs d a) (BSVal ks vs d b)
x -> (BSVal ks vs d a
 -> Maybe (ModelValue (BackingStoreState ks vs d) b))
-> (ModelValue (BackingStoreState ks vs d) b
    -> Maybe (ModelValue (BackingStoreState ks vs d) b))
-> Either
     (BSVal ks vs d a) (ModelValue (BackingStoreState ks vs d) b)
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (ModelValue (BackingStoreState ks vs d) b)
-> BSVal ks vs d a
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a b. a -> b -> a
const Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a. Maybe a
Nothing) ModelValue (BackingStoreState ks vs d) b
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a. a -> Maybe a
Just Either (BSVal ks vs d a) (ModelValue (BackingStoreState ks vs d) b)
Either (BSVal ks vs d a) (BSVal ks vs d b)
x
  intOp (OpComp Op b1 b
g Op a b1
f) = Op b1 b
-> ModelValue (BackingStoreState ks vs d) b1
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall a b.
Op a b
-> ModelValue (BackingStoreState ks vs d) a
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall (op :: * -> * -> *) (f :: * -> *) a b.
InterpretOp op f =>
op a b -> f a -> Maybe (f b)
intOp Op b1 b
g (ModelValue (BackingStoreState ks vs d) b1
 -> Maybe (ModelValue (BackingStoreState ks vs d) b))
-> (ModelValue (BackingStoreState ks vs d) a
    -> Maybe (ModelValue (BackingStoreState ks vs d) b1))
-> ModelValue (BackingStoreState ks vs d) a
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Op a b1
-> ModelValue (BackingStoreState ks vs d) a
-> Maybe (ModelValue (BackingStoreState ks vs d) b1)
forall a b.
Op a b
-> ModelValue (BackingStoreState ks vs d) a
-> Maybe (ModelValue (BackingStoreState ks vs d) b)
forall (op :: * -> * -> *) (f :: * -> *) a b.
InterpretOp op f =>
op a b -> f a -> Maybe (f b)
intOp Op a b1
f

{-------------------------------------------------------------------------------
  Interpreter for implementation (@'RealMonad'@)
-------------------------------------------------------------------------------}

runIO ::
  forall ks vs d a.
  LockstepAction (BackingStoreState ks vs d) a ->
  LookUp (RealMonad IO ks vs d) ->
  RealMonad IO ks vs d (Realized (RealMonad IO ks vs d) a)
runIO :: forall ks vs d a.
LockstepAction (BackingStoreState ks vs d) a
-> LookUp (RealMonad IO ks vs d)
-> RealMonad IO ks vs d (Realized (RealMonad IO ks vs d) a)
runIO LockstepAction (BackingStoreState ks vs d) a
action LookUp (RealMonad IO ks vs d)
lookUp = (RealEnv IO ks vs d -> IO (Realized (RealMonad IO ks vs d) a))
-> ReaderT
     (RealEnv IO ks vs d) IO (Realized (RealMonad IO ks vs d) a)
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((RealEnv IO ks vs d -> IO (Realized (RealMonad IO ks vs d) a))
 -> ReaderT
      (RealEnv IO ks vs d) IO (Realized (RealMonad IO ks vs d) a))
-> (RealEnv IO ks vs d -> IO (Realized (RealMonad IO ks vs d) a))
-> ReaderT
     (RealEnv IO ks vs d) IO (Realized (RealMonad IO ks vs d) a)
forall a b. (a -> b) -> a -> b
$ \RealEnv IO ks vs d
renv ->
  RealEnv IO ks vs d
-> LockstepAction (BackingStoreState ks vs d) a -> IO a
aux RealEnv IO ks vs d
renv LockstepAction (BackingStoreState ks vs d) a
action
 where
  aux ::
    RealEnv IO ks vs d ->
    LockstepAction (BackingStoreState ks vs d) a ->
    IO a
  aux :: RealEnv IO ks vs d
-> LockstepAction (BackingStoreState ks vs d) a -> IO a
aux RealEnv IO ks vs d
renv = \case
    BSInitFromValues WithOrigin SlotNo
sl InitHint vs
h (Values vs
vs) -> IO () -> IO (Either Err ())
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO () -> IO (Either Err ())) -> IO () -> IO (Either Err ())
forall a b. (a -> b) -> a -> b
$ do
      bs <- BackingStoreInitializer IO ks vs d
bsi (WithOrigin SlotNo -> InitHint vs -> vs -> InitFrom vs
forall values.
WithOrigin SlotNo -> InitHint values -> values -> InitFrom values
BS.InitFromValues WithOrigin SlotNo
sl InitHint vs
h vs
vs)
      void $ swapMVar bsVar bs
    BSInitFromCopy InitHint vs
h FsPath
bsp -> IO () -> IO (Either Err ())
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO () -> IO (Either Err ())) -> IO () -> IO (Either Err ())
forall a b. (a -> b) -> a -> b
$ do
      bs <- BackingStoreInitializer IO ks vs d
bsi (InitHint vs -> FsPath -> InitFrom vs
forall values. InitHint values -> FsPath -> InitFrom values
BS.InitFromCopy InitHint vs
h FsPath
bsp)
      void $ swapMVar bsVar bs
    LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSClose ->
      IO () -> IO (Either Err ())
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO () -> IO (Either Err ())) -> IO () -> IO (Either Err ())
forall a b. (a -> b) -> a -> b
$
        StrictMVar IO (BackingStore IO ks vs d)
-> IO (BackingStore IO ks vs d)
forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> m a
readMVar StrictMVar IO (BackingStore IO ks vs d)
bsVar IO (BackingStore IO ks vs d)
-> (BackingStore IO ks vs d -> 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
>>= BackingStore IO ks vs d -> IO ()
forall (m :: * -> *) keys values diff.
BackingStore m keys values diff -> m ()
BS.bsClose
    BSCopy SerializeTablesHint vs
s FsPath
bsp ->
      IO () -> IO (Either Err ())
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO () -> IO (Either Err ())) -> IO () -> IO (Either Err ())
forall a b. (a -> b) -> a -> b
$
        StrictMVar IO (BackingStore IO ks vs d)
-> IO (BackingStore IO ks vs d)
forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> m a
readMVar StrictMVar IO (BackingStore IO ks vs d)
bsVar IO (BackingStore IO ks vs d)
-> (BackingStore IO ks vs d -> 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
>>= \BackingStore IO ks vs d
bs -> BackingStore IO ks vs d
-> SerializeTablesHint vs -> FsPath -> IO ()
forall (m :: * -> *) keys values diff.
BackingStore m keys values diff
-> SerializeTablesHint values -> FsPath -> m ()
BS.bsCopy BackingStore IO ks vs d
bs SerializeTablesHint vs
s FsPath
bsp
    LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSValueHandle ->
      IO (BackingStoreValueHandle IO ks vs)
-> IO (Either Err (BackingStoreValueHandle IO ks vs))
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO (BackingStoreValueHandle IO ks vs)
 -> IO (Either Err (BackingStoreValueHandle IO ks vs)))
-> IO (BackingStoreValueHandle IO ks vs)
-> IO (Either Err (BackingStoreValueHandle IO ks vs))
forall a b. (a -> b) -> a -> b
$
        StrictMVar IO (BackingStore IO ks vs d)
-> IO (BackingStore IO ks vs d)
forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> m a
readMVar StrictMVar IO (BackingStore IO ks vs d)
bsVar IO (BackingStore IO ks vs d)
-> (BackingStore IO ks vs d
    -> IO (BackingStoreValueHandle IO ks vs))
-> IO (BackingStoreValueHandle IO ks vs)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BackingStore IO ks vs d -> IO (BackingStoreValueHandle IO ks vs)
forall (m :: * -> *) keys values diff.
BackingStore m keys values diff
-> m (BackingStoreValueHandle m keys values)
BS.bsValueHandle
    BSWrite SlotNo
sl WriteHint d
whint d
d ->
      IO () -> IO (Either Err ())
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO () -> IO (Either Err ())) -> IO () -> IO (Either Err ())
forall a b. (a -> b) -> a -> b
$
        StrictMVar IO (BackingStore IO ks vs d)
-> IO (BackingStore IO ks vs d)
forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> m a
readMVar StrictMVar IO (BackingStore IO ks vs d)
bsVar IO (BackingStore IO ks vs d)
-> (BackingStore IO ks vs d -> 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
>>= \BackingStore IO ks vs d
bs -> BackingStore IO ks vs d -> SlotNo -> WriteHint d -> d -> IO ()
forall (m :: * -> *) keys values diff.
BackingStore m keys values diff
-> SlotNo -> WriteHint diff -> diff -> m ()
BS.bsWrite BackingStore IO ks vs d
bs SlotNo
sl WriteHint d
whint d
d
    BSVHClose BSVar ks vs d (BackingStoreValueHandle IO ks vs)
var ->
      IO () -> IO (Either Err ())
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO () -> IO (Either Err ())) -> IO () -> IO (Either Err ())
forall a b. (a -> b) -> a -> b
$
        BackingStoreValueHandle IO ks vs -> IO ()
forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values -> m ()
BS.bsvhClose (BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> Realized
     (RealMonad IO ks vs d) (BackingStoreValueHandle IO ks vs)
forall x. BSVar ks vs d x -> Realized (RealMonad IO ks vs d) x
lookUp' BSVar ks vs d (BackingStoreValueHandle IO ks vs)
var)
    BSVHRangeRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
var ReadHint vs
rhint RangeQuery ks
rq ->
      IO (Values vs) -> IO (Either Err (Values vs))
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO (Values vs) -> IO (Either Err (Values vs)))
-> IO (Values vs) -> IO (Either Err (Values vs))
forall a b. (a -> b) -> a -> b
$
        vs -> Values vs
forall vs. vs -> Values vs
Values
          (vs -> Values vs) -> IO vs -> IO (Values vs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackingStoreValueHandle IO ks vs
-> ReadHint vs -> RangeQuery ks -> IO vs
forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values
-> ReadHint values -> RangeQuery keys -> m values
BS.bsvhRangeRead (BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> Realized
     (RealMonad IO ks vs d) (BackingStoreValueHandle IO ks vs)
forall x. BSVar ks vs d x -> Realized (RealMonad IO ks vs d) x
lookUp' BSVar ks vs d (BackingStoreValueHandle IO ks vs)
var) ReadHint vs
rhint RangeQuery ks
rq
    BSVHRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
var ReadHint vs
rhint ks
ks ->
      IO (Values vs) -> IO (Either Err (Values vs))
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO (Values vs) -> IO (Either Err (Values vs)))
-> IO (Values vs) -> IO (Either Err (Values vs))
forall a b. (a -> b) -> a -> b
$
        vs -> Values vs
forall vs. vs -> Values vs
Values
          (vs -> Values vs) -> IO vs -> IO (Values vs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BackingStoreValueHandle IO ks vs -> ReadHint vs -> ks -> IO vs
forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values
-> ReadHint values -> keys -> m values
BS.bsvhRead (BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> Realized
     (RealMonad IO ks vs d) (BackingStoreValueHandle IO ks vs)
forall x. BSVar ks vs d x -> Realized (RealMonad IO ks vs d) x
lookUp' BSVar ks vs d (BackingStoreValueHandle IO ks vs)
var) ReadHint vs
rhint ks
ks
    BSVHAtSlot BSVar ks vs d (BackingStoreValueHandle IO ks vs)
var ->
      IO (WithOrigin SlotNo) -> IO (Either Err (WithOrigin SlotNo))
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO (WithOrigin SlotNo) -> IO (Either Err (WithOrigin SlotNo)))
-> IO (WithOrigin SlotNo) -> IO (Either Err (WithOrigin SlotNo))
forall a b. (a -> b) -> a -> b
$
        WithOrigin SlotNo -> IO (WithOrigin SlotNo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BackingStoreValueHandle IO ks vs -> WithOrigin SlotNo
forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values -> WithOrigin SlotNo
BS.bsvhAtSlot (BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> Realized
     (RealMonad IO ks vs d) (BackingStoreValueHandle IO ks vs)
forall x. BSVar ks vs d x -> Realized (RealMonad IO ks vs d) x
lookUp' BSVar ks vs d (BackingStoreValueHandle IO ks vs)
var))
    BSVHStat BSVar ks vs d (BackingStoreValueHandle IO ks vs)
var ->
      IO Statistics -> IO (Either Err Statistics)
forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr (IO Statistics -> IO (Either Err Statistics))
-> IO Statistics -> IO (Either Err Statistics)
forall a b. (a -> b) -> a -> b
$
        BackingStoreValueHandle IO ks vs -> IO Statistics
forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values -> m Statistics
BS.bsvhStat (BSVar ks vs d (BackingStoreValueHandle IO ks vs)
-> Realized
     (RealMonad IO ks vs d) (BackingStoreValueHandle IO ks vs)
forall x. BSVar ks vs d x -> Realized (RealMonad IO ks vs d) x
lookUp' BSVar ks vs d (BackingStoreValueHandle IO ks vs)
var)
   where
    RealEnv
      { reBackingStoreInit :: forall (m :: * -> *) ks vs d.
RealEnv m ks vs d -> BackingStoreInitializer m ks vs d
reBackingStoreInit = BackingStoreInitializer IO ks vs d
bsi
      , reBackingStore :: forall (m :: * -> *) ks vs d.
RealEnv m ks vs d -> StrictMVar m (BackingStore m ks vs d)
reBackingStore = StrictMVar IO (BackingStore IO ks vs d)
bsVar
      } = RealEnv IO ks vs d
renv

    lookUp' :: BSVar ks vs d x -> Realized (RealMonad IO ks vs d) x
    lookUp' :: forall x. BSVar ks vs d x -> Realized (RealMonad IO ks vs d) x
lookUp' = Proxy (RealMonad IO ks vs d)
-> LookUp (RealMonad IO ks vs d)
-> GVar Op x
-> Realized (RealMonad IO ks vs d) x
forall (op :: * -> * -> *) (m :: * -> *) a.
InterpretOp op (WrapRealized m) =>
Proxy m -> LookUp m -> GVar op a -> Realized m a
lookUpGVar (forall {k} (t :: k). Proxy t
forall (t :: * -> *). Proxy t
Proxy @(RealMonad IO ks vs d)) Var a -> Realized (RealMonad IO ks vs d) a
LookUp (RealMonad IO ks vs d)
lookUp

catchErr :: forall m a. IOLike m => m a -> m (Either Err a)
catchErr :: forall (m :: * -> *) a. IOLike m => m a -> m (Either Err a)
catchErr m a
act =
  m (Either Err a) -> [Handler m (Either Err a)] -> m (Either Err a)
forall (m :: * -> *) a. MonadCatch m => m a -> [Handler m a] -> m a
catches
    (a -> Either Err a
forall a b. b -> Either a b
Right (a -> Either Err a) -> m a -> m (Either Err a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
act)
    [(InMemoryBackingStoreExn -> Maybe Err) -> Handler m (Either Err a)
forall (m :: * -> *) e a.
(IOLike m, Exception e) =>
(e -> Maybe Err) -> Handler m (Either Err a)
mkHandler InMemoryBackingStoreExn -> Maybe Err
fromTVarExn, (InMemoryBackingStoreInitExn -> Maybe Err)
-> Handler m (Either Err a)
forall (m :: * -> *) e a.
(IOLike m, Exception e) =>
(e -> Maybe Err) -> Handler m (Either Err a)
mkHandler InMemoryBackingStoreInitExn -> Maybe Err
fromTVarExn', (LMDBErr -> Maybe Err) -> Handler m (Either Err a)
forall (m :: * -> *) e a.
(IOLike m, Exception e) =>
(e -> Maybe Err) -> Handler m (Either Err a)
mkHandler LMDBErr -> Maybe Err
fromDbErr]

{-------------------------------------------------------------------------------
  Statistics and tagging
-------------------------------------------------------------------------------}

data Stats ks vs d = Stats
  { forall ks vs d.
Stats ks vs d -> Map (ValueHandle vs) (WithOrigin SlotNo)
handleSlots :: Map (ValueHandle vs) (WithOrigin SlotNo)
  -- ^ Slots that value handles were created in
  , forall ks vs d. Stats ks vs d -> Map SlotNo Int
writeSlots :: Map SlotNo Int
  -- ^ Slots in which writes were performed
  , forall ks vs d. Stats ks vs d -> Bool
readAfterWrite :: Bool
  -- ^ A value handle was created before a write, and read after the write
  , forall ks vs d. Stats ks vs d -> Bool
rangeReadAfterWrite :: Bool
  -- ^ A value handle was created before a write, and range read after the
  -- write
  }
  deriving stock (Int -> Stats ks vs d -> ShowS
[Stats ks vs d] -> ShowS
Stats ks vs d -> String
(Int -> Stats ks vs d -> ShowS)
-> (Stats ks vs d -> String)
-> ([Stats ks vs d] -> ShowS)
-> Show (Stats ks vs d)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall ks vs d. Show vs => Int -> Stats ks vs d -> ShowS
forall ks vs d. Show vs => [Stats ks vs d] -> ShowS
forall ks vs d. Show vs => Stats ks vs d -> String
$cshowsPrec :: forall ks vs d. Show vs => Int -> Stats ks vs d -> ShowS
showsPrec :: Int -> Stats ks vs d -> ShowS
$cshow :: forall ks vs d. Show vs => Stats ks vs d -> String
show :: Stats ks vs d -> String
$cshowList :: forall ks vs d. Show vs => [Stats ks vs d] -> ShowS
showList :: [Stats ks vs d] -> ShowS
Show, Stats ks vs d -> Stats ks vs d -> Bool
(Stats ks vs d -> Stats ks vs d -> Bool)
-> (Stats ks vs d -> Stats ks vs d -> Bool) -> Eq (Stats ks vs d)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall ks vs d. Stats ks vs d -> Stats ks vs d -> Bool
$c== :: forall ks vs d. Stats ks vs d -> Stats ks vs d -> Bool
== :: Stats ks vs d -> Stats ks vs d -> Bool
$c/= :: forall ks vs d. Stats ks vs d -> Stats ks vs d -> Bool
/= :: Stats ks vs d -> Stats ks vs d -> Bool
Eq)

initStats :: Stats ks vs d
initStats :: forall ks vs d. Stats ks vs d
initStats =
  Stats
    { handleSlots :: Map (ValueHandle vs) (WithOrigin SlotNo)
handleSlots = Map (ValueHandle vs) (WithOrigin SlotNo)
forall k a. Map k a
Map.empty
    , writeSlots :: Map SlotNo Int
writeSlots = Map SlotNo Int
forall k a. Map k a
Map.empty
    , readAfterWrite :: Bool
readAfterWrite = Bool
False
    , rangeReadAfterWrite :: Bool
rangeReadAfterWrite = Bool
False
    }

updateStats ::
  forall ks vs d a.
  ( Mock.HasOps ks vs d
  , QC.Arbitrary ks
  , QC.Arbitrary vs
  , QC.Arbitrary d
  , QC.Arbitrary (BS.RangeQuery ks)
  ) =>
  LockstepAction (BackingStoreState ks vs d) a ->
  ModelVarContext (BackingStoreState ks vs d) ->
  BSVal ks vs d a ->
  Stats ks vs d ->
  Stats ks vs d
updateStats :: forall ks vs d a.
(HasOps ks vs d, Arbitrary ks, Arbitrary vs, Arbitrary d,
 Arbitrary (RangeQuery ks)) =>
LockstepAction (BackingStoreState ks vs d) a
-> ModelVarContext (BackingStoreState ks vs d)
-> BSVal ks vs d a
-> Stats ks vs d
-> Stats ks vs d
updateStats LockstepAction (BackingStoreState ks vs d) a
action ModelVarContext (BackingStoreState ks vs d)
lookUp BSVal ks vs d a
result stats :: Stats ks vs d
stats@Stats{Map (ValueHandle vs) (WithOrigin SlotNo)
handleSlots :: forall ks vs d.
Stats ks vs d -> Map (ValueHandle vs) (WithOrigin SlotNo)
handleSlots :: Map (ValueHandle vs) (WithOrigin SlotNo)
handleSlots, Map SlotNo Int
writeSlots :: forall ks vs d. Stats ks vs d -> Map SlotNo Int
writeSlots :: Map SlotNo Int
writeSlots} =
  Stats ks vs d -> Stats ks vs d
updateHandleSlots
    (Stats ks vs d -> Stats ks vs d)
-> (Stats ks vs d -> Stats ks vs d)
-> Stats ks vs d
-> Stats ks vs d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats ks vs d -> Stats ks vs d
updateWriteSlots
    (Stats ks vs d -> Stats ks vs d)
-> (Stats ks vs d -> Stats ks vs d)
-> Stats ks vs d
-> Stats ks vs d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats ks vs d -> Stats ks vs d
updateReadAfterWrite
    (Stats ks vs d -> Stats ks vs d)
-> (Stats ks vs d -> Stats ks vs d)
-> Stats ks vs d
-> Stats ks vs d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stats ks vs d -> Stats ks vs d
updateRangeReadAfterWrite
    (Stats ks vs d -> Stats ks vs d) -> Stats ks vs d -> Stats ks vs d
forall a b. (a -> b) -> a -> b
$ Stats ks vs d
stats
 where
  getHandle :: BSVal ks vs d (BS.BackingStoreValueHandle IO ks vs) -> ValueHandle vs
  getHandle :: BSVal ks vs d (BackingStoreValueHandle IO ks vs) -> ValueHandle vs
getHandle (MValueHandle ValueHandle vs
h) = ValueHandle vs
h

  updateHandleSlots :: Stats ks vs d -> Stats ks vs d
  updateHandleSlots :: Stats ks vs d -> Stats ks vs d
updateHandleSlots Stats ks vs d
s = case (LockstepAction (BackingStoreState ks vs d) a
action, BSVal ks vs d a
result) of
    (LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSValueHandle, MEither (Right (MValueHandle ValueHandle vs
h))) ->
      Stats ks vs d
s{handleSlots = Map.insert h (seqNo h) handleSlots}
    (LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSClose, MEither (Right BSVal ks vs d b
_)) ->
      Stats ks vs d
s{handleSlots = Map.empty}
    (BSVHClose BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h, MEither (Right BSVal ks vs d b
_)) ->
      Stats ks vs d
s{handleSlots = Map.delete (getHandle $ lookupVar lookUp h) handleSlots}
    (LockstepAction (BackingStoreState ks vs d) a, BSVal ks vs d a)
_ -> Stats ks vs d
s

  updateWriteSlots :: Stats ks vs d -> Stats ks vs d
  updateWriteSlots :: Stats ks vs d -> Stats ks vs d
updateWriteSlots Stats ks vs d
s = case (LockstepAction (BackingStoreState ks vs d) a
action, BSVal ks vs d a
result) of
    (BSWrite SlotNo
sl WriteHint d
_ d
d, MEither (Right (MUnit ())))
      | Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= d -> Int
forall d. DiffSize d => d -> Int
Mock.diffSize d
d ->
          Stats ks vs d
s{writeSlots = Map.insert sl (Mock.diffSize d) writeSlots}
    (LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSClose, MEither (Right BSVal ks vs d b
_)) ->
      Stats ks vs d
s{writeSlots = Map.empty}
    (LockstepAction (BackingStoreState ks vs d) a, BSVal ks vs d a)
_ -> Stats ks vs d
s

  updateReadAfterWrite :: Stats ks vs d -> Stats ks vs d
  updateReadAfterWrite :: Stats ks vs d -> Stats ks vs d
updateReadAfterWrite Stats ks vs d
s = case (LockstepAction (BackingStoreState ks vs d) a
action, BSVal ks vs d a
result) of
    (BSVHRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ReadHint vs
_ ks
_, MEither (Right (MValues vs
vs)))
      | ValueHandle vs
h' <- BSVal ks vs d (BackingStoreValueHandle IO ks vs) -> ValueHandle vs
getHandle (BSVal ks vs d (BackingStoreValueHandle IO ks vs)
 -> ValueHandle vs)
-> BSVal ks vs d (BackingStoreValueHandle IO ks vs)
-> ValueHandle vs
forall a b. (a -> b) -> a -> b
$ ModelVarContext (BackingStoreState ks vs d)
-> ModelLookUp (BackingStoreState ks vs d)
forall state.
InLockstep state =>
ModelVarContext state -> ModelLookUp state
lookupVar ModelVarContext (BackingStoreState ks vs d)
lookUp BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h
      , Just WithOrigin SlotNo
wosl <- ValueHandle vs
-> Map (ValueHandle vs) (WithOrigin SlotNo)
-> Maybe (WithOrigin SlotNo)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ValueHandle vs
h' Map (ValueHandle vs) (WithOrigin SlotNo)
handleSlots
      , Just (SlotNo
sl, Int
_) <- Map SlotNo Int -> Maybe (SlotNo, Int)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map SlotNo Int
writeSlots
      , WithOrigin SlotNo
wosl WithOrigin SlotNo -> WithOrigin SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
at SlotNo
sl
      , Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= vs -> Int
forall vs. ValuesLength vs => vs -> Int
Mock.valuesLength vs
vs ->
          Stats ks vs d
s{readAfterWrite = True}
    (LockstepAction (BackingStoreState ks vs d) a, BSVal ks vs d a)
_ -> Stats ks vs d
s

  updateRangeReadAfterWrite :: Stats ks vs d -> Stats ks vs d
  updateRangeReadAfterWrite :: Stats ks vs d -> Stats ks vs d
updateRangeReadAfterWrite Stats ks vs d
s = case (LockstepAction (BackingStoreState ks vs d) a
action, BSVal ks vs d a
result) of
    (BSVHRangeRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h ReadHint vs
_ RangeQuery ks
_, MEither (Right (MValues vs
vs)))
      | ValueHandle vs
h' <- BSVal ks vs d (BackingStoreValueHandle IO ks vs) -> ValueHandle vs
getHandle (BSVal ks vs d (BackingStoreValueHandle IO ks vs)
 -> ValueHandle vs)
-> BSVal ks vs d (BackingStoreValueHandle IO ks vs)
-> ValueHandle vs
forall a b. (a -> b) -> a -> b
$ ModelVarContext (BackingStoreState ks vs d)
-> ModelLookUp (BackingStoreState ks vs d)
forall state.
InLockstep state =>
ModelVarContext state -> ModelLookUp state
lookupVar ModelVarContext (BackingStoreState ks vs d)
lookUp BSVar ks vs d (BackingStoreValueHandle IO ks vs)
h
      , Just WithOrigin SlotNo
wosl <- ValueHandle vs
-> Map (ValueHandle vs) (WithOrigin SlotNo)
-> Maybe (WithOrigin SlotNo)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ValueHandle vs
h' Map (ValueHandle vs) (WithOrigin SlotNo)
handleSlots
      , Just (SlotNo
sl, Int
_) <- Map SlotNo Int -> Maybe (SlotNo, Int)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax Map SlotNo Int
writeSlots
      , WithOrigin SlotNo
wosl WithOrigin SlotNo -> WithOrigin SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
< SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
at SlotNo
sl
      , Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= vs -> Int
forall vs. ValuesLength vs => vs -> Int
Mock.valuesLength vs
vs ->
          Stats ks vs d
s{rangeReadAfterWrite = True}
    (LockstepAction (BackingStoreState ks vs d) a, BSVal ks vs d a)
_ -> Stats ks vs d
s

data TagAction
  = TBSInitFromValues
  | TBSInitFromCopy
  | TBSClose
  | TBSCopy
  | TBSValueHandle
  | TBSWrite
  | TBSVHClose
  | TBSVHRangeRead
  | TBSVHRead
  | TBSVHAtSlot
  | TBSVHStat
  deriving (Int -> TagAction -> ShowS
[TagAction] -> ShowS
TagAction -> String
(Int -> TagAction -> ShowS)
-> (TagAction -> String)
-> ([TagAction] -> ShowS)
-> Show TagAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TagAction -> ShowS
showsPrec :: Int -> TagAction -> ShowS
$cshow :: TagAction -> String
show :: TagAction -> String
$cshowList :: [TagAction] -> ShowS
showList :: [TagAction] -> ShowS
Show, TagAction -> TagAction -> Bool
(TagAction -> TagAction -> Bool)
-> (TagAction -> TagAction -> Bool) -> Eq TagAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TagAction -> TagAction -> Bool
== :: TagAction -> TagAction -> Bool
$c/= :: TagAction -> TagAction -> Bool
/= :: TagAction -> TagAction -> Bool
Eq, Eq TagAction
Eq TagAction =>
(TagAction -> TagAction -> Ordering)
-> (TagAction -> TagAction -> Bool)
-> (TagAction -> TagAction -> Bool)
-> (TagAction -> TagAction -> Bool)
-> (TagAction -> TagAction -> Bool)
-> (TagAction -> TagAction -> TagAction)
-> (TagAction -> TagAction -> TagAction)
-> Ord TagAction
TagAction -> TagAction -> Bool
TagAction -> TagAction -> Ordering
TagAction -> TagAction -> TagAction
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TagAction -> TagAction -> Ordering
compare :: TagAction -> TagAction -> Ordering
$c< :: TagAction -> TagAction -> Bool
< :: TagAction -> TagAction -> Bool
$c<= :: TagAction -> TagAction -> Bool
<= :: TagAction -> TagAction -> Bool
$c> :: TagAction -> TagAction -> Bool
> :: TagAction -> TagAction -> Bool
$c>= :: TagAction -> TagAction -> Bool
>= :: TagAction -> TagAction -> Bool
$cmax :: TagAction -> TagAction -> TagAction
max :: TagAction -> TagAction -> TagAction
$cmin :: TagAction -> TagAction -> TagAction
min :: TagAction -> TagAction -> TagAction
Ord, TagAction
TagAction -> TagAction -> Bounded TagAction
forall a. a -> a -> Bounded a
$cminBound :: TagAction
minBound :: TagAction
$cmaxBound :: TagAction
maxBound :: TagAction
Bounded, Int -> TagAction
TagAction -> Int
TagAction -> [TagAction]
TagAction -> TagAction
TagAction -> TagAction -> [TagAction]
TagAction -> TagAction -> TagAction -> [TagAction]
(TagAction -> TagAction)
-> (TagAction -> TagAction)
-> (Int -> TagAction)
-> (TagAction -> Int)
-> (TagAction -> [TagAction])
-> (TagAction -> TagAction -> [TagAction])
-> (TagAction -> TagAction -> [TagAction])
-> (TagAction -> TagAction -> TagAction -> [TagAction])
-> Enum TagAction
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: TagAction -> TagAction
succ :: TagAction -> TagAction
$cpred :: TagAction -> TagAction
pred :: TagAction -> TagAction
$ctoEnum :: Int -> TagAction
toEnum :: Int -> TagAction
$cfromEnum :: TagAction -> Int
fromEnum :: TagAction -> Int
$cenumFrom :: TagAction -> [TagAction]
enumFrom :: TagAction -> [TagAction]
$cenumFromThen :: TagAction -> TagAction -> [TagAction]
enumFromThen :: TagAction -> TagAction -> [TagAction]
$cenumFromTo :: TagAction -> TagAction -> [TagAction]
enumFromTo :: TagAction -> TagAction -> [TagAction]
$cenumFromThenTo :: TagAction -> TagAction -> TagAction -> [TagAction]
enumFromThenTo :: TagAction -> TagAction -> TagAction -> [TagAction]
Enum)

-- | Identify actions by their constructor.
tAction :: LockstepAction (BackingStoreState ks vs d) a -> TagAction
tAction :: forall ks vs d a.
LockstepAction (BackingStoreState ks vs d) a -> TagAction
tAction = \case
  BSInitFromValues WithOrigin SlotNo
_ InitHint vs
_ Values vs
_ -> TagAction
TBSInitFromValues
  BSInitFromCopy InitHint vs
_ FsPath
_ -> TagAction
TBSInitFromCopy
  LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSClose -> TagAction
TBSClose
  BSCopy SerializeTablesHint vs
_ FsPath
_ -> TagAction
TBSCopy
  LockstepAction (BackingStoreState ks vs d) a
R:ActionLockstepa ks vs d a
BSValueHandle -> TagAction
TBSValueHandle
  BSWrite SlotNo
_ WriteHint d
_ d
_ -> TagAction
TBSWrite
  BSVHClose BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ -> TagAction
TBSVHClose
  BSVHRangeRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ ReadHint vs
_ RangeQuery ks
_ -> TagAction
TBSVHRangeRead
  BSVHRead BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ ReadHint vs
_ ks
_ -> TagAction
TBSVHRead
  BSVHAtSlot BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ -> TagAction
TBSVHAtSlot
  BSVHStat BSVar ks vs d (BackingStoreValueHandle IO ks vs)
_ -> TagAction
TBSVHStat

data Tag
  = -- | A value handle is created before a write, and read after the write. The
    -- write should not affect the result of the read.
    ReadAfterWrite
  | -- | A value handle is created before a write, and read after the write. The
    -- write should not affect the result of the read.
    RangeReadAfterWrite
  | ErrorBecauseBackingStoreIsClosed TagAction
  | ErrorBecauseBackingStoreValueHandleIsClosed TagAction
  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

tagBSAction ::
  Stats ks vs d ->
  Stats ks vs d ->
  LockstepAction (BackingStoreState ks vs d) a ->
  BSVal ks vs d a ->
  [Tag]
tagBSAction :: forall ks vs d a.
Stats ks vs d
-> Stats ks vs d
-> LockstepAction (BackingStoreState ks vs d) a
-> BSVal ks vs d a
-> [Tag]
tagBSAction Stats ks vs d
before Stats ks vs d
after LockstepAction (BackingStoreState ks vs d) a
action BSVal ks vs d a
result =
  [Tag]
globalTags [Tag] -> [Tag] -> [Tag]
forall a. [a] -> [a] -> [a]
++ case (LockstepAction (BackingStoreState ks vs d) a
action, BSVal ks vs d a
result) of
    (LockstepAction (BackingStoreState ks vs d) a
_, MEither (Left (MErr Err
ErrBackingStoreClosed))) ->
      [TagAction -> Tag
ErrorBecauseBackingStoreIsClosed (LockstepAction (BackingStoreState ks vs d) a -> TagAction
forall ks vs d a.
LockstepAction (BackingStoreState ks vs d) a -> TagAction
tAction LockstepAction (BackingStoreState ks vs d) a
action)]
    (LockstepAction (BackingStoreState ks vs d) a
_, MEither (Left (MErr Err
ErrBackingStoreValueHandleClosed))) ->
      [TagAction -> Tag
ErrorBecauseBackingStoreValueHandleIsClosed (LockstepAction (BackingStoreState ks vs d) a -> TagAction
forall ks vs d a.
LockstepAction (BackingStoreState ks vs d) a -> TagAction
tAction LockstepAction (BackingStoreState ks vs d) a
action)]
    (LockstepAction (BackingStoreState ks vs d) a, BSVal ks vs d a)
_ -> []
 where
  globalTags :: [Tag]
globalTags =
    [[Tag]] -> [Tag]
forall a. Monoid a => [a] -> a
mconcat
      [ [ Tag
ReadAfterWrite
        | Bool -> Bool
not (Stats ks vs d -> Bool
forall ks vs d. Stats ks vs d -> Bool
readAfterWrite Stats ks vs d
before)
        , Stats ks vs d -> Bool
forall ks vs d. Stats ks vs d -> Bool
readAfterWrite Stats ks vs d
after
        ]
      , [ Tag
RangeReadAfterWrite
        | Bool -> Bool
not (Stats ks vs d -> Bool
forall ks vs d. Stats ks vs d -> Bool
rangeReadAfterWrite Stats ks vs d
before)
        , Stats ks vs d -> Bool
forall ks vs d. Stats ks vs d -> Bool
rangeReadAfterWrite Stats ks vs d
after
        ]
      ]

{-------------------------------------------------------------------------------
  Errors
-------------------------------------------------------------------------------}

mkHandler ::
  (IOLike m, Exception e) =>
  (e -> Maybe Err) ->
  Handler m (Either Err a)
mkHandler :: forall (m :: * -> *) e a.
(IOLike m, Exception e) =>
(e -> Maybe Err) -> Handler m (Either Err a)
mkHandler e -> Maybe Err
fhandler = (e -> m (Either Err a)) -> Handler m (Either Err a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((e -> m (Either Err a)) -> Handler m (Either Err a))
-> (e -> m (Either Err a)) -> Handler m (Either Err a)
forall a b. (a -> b) -> a -> b
$
  \e
e -> m (Either Err a)
-> (Err -> m (Either Err a)) -> Maybe Err -> m (Either Err a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> m (Either Err a)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO e
e) (Either Err a -> m (Either Err a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Err a -> m (Either Err a))
-> (Err -> Either Err a) -> Err -> m (Either Err a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Err -> Either Err a
forall a b. a -> Either a b
Left) (e -> Maybe Err
fhandler e
e)

-- | Map LMDB errors to mock errors.
fromDbErr :: LMDB.LMDBErr -> Maybe Err
fromDbErr :: LMDBErr -> Maybe Err
fromDbErr = \case
  LMDBErr
LMDBErrNoDbSeqNo -> Maybe Err
forall a. Maybe a
Nothing
  LMDBErrNonMonotonicSeq WithOrigin SlotNo
wo WithOrigin SlotNo
wo' -> Err -> Maybe Err
forall a. a -> Maybe a
Just (Err -> Maybe Err) -> Err -> Maybe Err
forall a b. (a -> b) -> a -> b
$ WithOrigin SlotNo -> WithOrigin SlotNo -> Err
ErrNonMonotonicSeqNo WithOrigin SlotNo
wo WithOrigin SlotNo
wo'
  LMDBErrInitialisingNonEmpty String
_ -> Maybe Err
forall a. Maybe a
Nothing
  LMDBErrNoValueHandle Int
_ -> Err -> Maybe Err
forall a. a -> Maybe a
Just Err
ErrBackingStoreValueHandleClosed
  LMDBErr
LMDBErrBadRead -> Maybe Err
forall a. Maybe a
Nothing
  LMDBErr
LMDBErrBadRangeRead -> Maybe Err
forall a. Maybe a
Nothing
  LMDBErrDirExists String
_ -> Err -> Maybe Err
forall a. a -> Maybe a
Just Err
ErrCopyPathAlreadyExists
  LMDBErrDirDoesntExist String
_ -> Err -> Maybe Err
forall a. a -> Maybe a
Just Err
ErrCopyPathDoesNotExist
  LMDBErrDirIsNotLMDB String
_ -> Maybe Err
forall a. Maybe a
Nothing
  LMDBErr
LMDBErrClosed -> Err -> Maybe Err
forall a. a -> Maybe a
Just Err
ErrBackingStoreClosed
  LMDBErr
LMDBErrInitialisingAlreadyHasState -> Maybe Err
forall a. Maybe a
Nothing
  LMDBErr
LMDBErrUnableToReadSeqNo -> Maybe Err
forall a. Maybe a
Nothing
  LMDBErrNotADir FsPath
_ -> Maybe Err
forall a. Maybe a
Nothing

-- | Map InMemory (i.e., @TVarBackingStore@) errors to mock errors.
fromTVarExn :: BS.InMemoryBackingStoreExn -> Maybe Err
fromTVarExn :: InMemoryBackingStoreExn -> Maybe Err
fromTVarExn = \case
  InMemoryBackingStoreExn
BS.InMemoryBackingStoreClosedExn -> Err -> Maybe Err
forall a. a -> Maybe a
Just Err
ErrBackingStoreClosed
  InMemoryBackingStoreExn
BS.InMemoryBackingStoreValueHandleClosedExn -> Err -> Maybe Err
forall a. a -> Maybe a
Just Err
ErrBackingStoreValueHandleClosed
  InMemoryBackingStoreExn
BS.InMemoryBackingStoreDirectoryExists -> Err -> Maybe Err
forall a. a -> Maybe a
Just Err
ErrCopyPathAlreadyExists
  BS.InMemoryBackingStoreNonMonotonicSeq WithOrigin SlotNo
wo WithOrigin SlotNo
wo' -> Err -> Maybe Err
forall a. a -> Maybe a
Just (Err -> Maybe Err) -> Err -> Maybe Err
forall a b. (a -> b) -> a -> b
$ WithOrigin SlotNo -> WithOrigin SlotNo -> Err
ErrNonMonotonicSeqNo WithOrigin SlotNo
wo WithOrigin SlotNo
wo'
  BS.InMemoryBackingStoreDeserialiseExn DeserialiseFailure
_ -> Maybe Err
forall a. Maybe a
Nothing
  InMemoryBackingStoreExn
BS.InMemoryIncompleteDeserialiseExn -> Maybe Err
forall a. Maybe a
Nothing

fromTVarExn' :: BS.InMemoryBackingStoreInitExn -> Maybe Err
fromTVarExn' :: InMemoryBackingStoreInitExn -> Maybe Err
fromTVarExn' = \case
  BS.StoreDirIsIncompatible FsErrorPath
_ -> Err -> Maybe Err
forall a. a -> Maybe a
Just Err
ErrCopyPathDoesNotExist