-- | Tests for the 'EventSource' and 'EventSink' implementation in 'Hydra.Events.FileBased'.
module Hydra.Events.FileBasedSpec where

import Hydra.Prelude hiding (label)
import Test.Hydra.Prelude

-- IsChainState tx instance to serialize 'StateEvent Tx'
import Hydra.Chain.Direct.State ()

import Conduit (runConduitRes, sinkList, (.|))
import Hydra.Events (EventSink (..), EventSource (..), StateEvent (..), getEvents, putEvent)
import Hydra.Events.FileBased (eventPairFromPersistenceIncremental)
import Hydra.HeadLogic (StateChanged)
import Hydra.Ledger.Cardano (Tx)
import Hydra.Ledger.Simple (SimpleTx)
import Hydra.Persistence (PersistenceIncremental (..), createPersistenceIncremental)
import Test.Aeson.GenericSpecs (
  Settings (..),
  defaultSettings,
  roundtripAndGoldenADTSpecsWithSettings,
  roundtripAndGoldenSpecsWithSettings,
 )
import Test.QuickCheck (forAllShrink, ioProperty, sublistOf, (===))
import Test.QuickCheck.Gen (listOf)

spec :: Spec
spec :: Spec
spec = do
  FilePath -> Spec -> Spec
forall a. HasCallStack => FilePath -> SpecWith a -> SpecWith a
describe FilePath
"persisted event format" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    -- NOTE: Whenever one of these fails, make sure to record a **BREAKING** change of the persisted 'state'.
    Settings -> Proxy (StateEvent Tx) -> Spec
forall a.
(Arbitrary a, ToJSON a, FromJSON a, Typeable a) =>
Settings -> Proxy a -> Spec
roundtripAndGoldenSpecsWithSettings (Settings
defaultSettings{sampleSize = 5}) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(StateEvent Tx))
    Settings -> Proxy (StateChanged Tx) -> Spec
forall a.
(Arbitrary a, ToADTArbitrary a, Eq a, Show a, ToJSON a,
 FromJSON a) =>
Settings -> Proxy a -> Spec
roundtripAndGoldenADTSpecsWithSettings (Settings
defaultSettings{sampleSize = 1}) (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(StateChanged Tx))

  FilePath -> Spec -> Spec
forall a. HasCallStack => FilePath -> SpecWith a -> SpecWith a
describe FilePath
"eventPairFromPersistenceIncremental" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    FilePath -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
FilePath -> prop -> Spec
prop FilePath
"can stream events" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Gen [StateEvent SimpleTx]
-> ([StateEvent SimpleTx] -> [[StateEvent SimpleTx]])
-> ([StateEvent SimpleTx] -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen [StateEvent SimpleTx]
genContinuousEvents [StateEvent SimpleTx] -> [[StateEvent SimpleTx]]
forall a. Arbitrary a => a -> [a]
shrink (([StateEvent SimpleTx] -> Property) -> Property)
-> ([StateEvent SimpleTx] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[StateEvent SimpleTx]
events ->
        IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$
          (EventSource (StateEvent SimpleTx) IO
 -> EventSink (StateEvent SimpleTx) IO -> IO Property)
-> IO Property
forall b.
(EventSource (StateEvent SimpleTx) IO
 -> EventSink (StateEvent SimpleTx) IO -> IO b)
-> IO b
withEventSourceAndSink ((EventSource (StateEvent SimpleTx) IO
  -> EventSink (StateEvent SimpleTx) IO -> IO Property)
 -> IO Property)
-> (EventSource (StateEvent SimpleTx) IO
    -> EventSink (StateEvent SimpleTx) IO -> IO Property)
-> IO Property
forall a b. (a -> b) -> a -> b
$ \EventSource{HasEventId (StateEvent SimpleTx) =>
ConduitT () (StateEvent SimpleTx) (ResourceT IO) ()
sourceEvents :: HasEventId (StateEvent SimpleTx) =>
ConduitT () (StateEvent SimpleTx) (ResourceT IO) ()
$sel:sourceEvents:EventSource :: forall e (m :: * -> *).
EventSource e m -> HasEventId e => ConduitT () e (ResourceT m) ()
sourceEvents} EventSink{HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
$sel:putEvent:EventSink :: forall e (m :: * -> *). EventSink e m -> HasEventId e => e -> m ()
putEvent :: HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
putEvent} -> do
            -- Put some events
            [StateEvent SimpleTx] -> (StateEvent SimpleTx -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [StateEvent SimpleTx]
events HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
StateEvent SimpleTx -> IO ()
putEvent
            [StateEvent SimpleTx]
streamedEvents <- ConduitT () Void (ResourceT IO) [StateEvent SimpleTx]
-> IO [StateEvent SimpleTx]
forall (m :: * -> *) r.
MonadUnliftIO m =>
ConduitT () Void (ResourceT m) r -> m r
runConduitRes (ConduitT () Void (ResourceT IO) [StateEvent SimpleTx]
 -> IO [StateEvent SimpleTx])
-> ConduitT () Void (ResourceT IO) [StateEvent SimpleTx]
-> IO [StateEvent SimpleTx]
forall a b. (a -> b) -> a -> b
$ ConduitT () (StateEvent SimpleTx) (ResourceT IO) ()
HasEventId (StateEvent SimpleTx) =>
ConduitT () (StateEvent SimpleTx) (ResourceT IO) ()
sourceEvents ConduitT () (StateEvent SimpleTx) (ResourceT IO) ()
-> ConduitT
     (StateEvent SimpleTx) Void (ResourceT IO) [StateEvent SimpleTx]
-> ConduitT () Void (ResourceT IO) [StateEvent SimpleTx]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT
  (StateEvent SimpleTx) Void (ResourceT IO) [StateEvent SimpleTx]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
sinkList
            Property -> IO Property
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$
              [StateEvent SimpleTx]
streamedEvents [StateEvent SimpleTx] -> [StateEvent SimpleTx] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [StateEvent SimpleTx]
events

    FilePath -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
FilePath -> prop -> Spec
prop FilePath
"can handle continuous events" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Gen [StateEvent SimpleTx]
-> ([StateEvent SimpleTx] -> [[StateEvent SimpleTx]])
-> ([StateEvent SimpleTx] -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen [StateEvent SimpleTx]
genContinuousEvents [StateEvent SimpleTx] -> [[StateEvent SimpleTx]]
forall a. Arbitrary a => a -> [a]
shrink (([StateEvent SimpleTx] -> Property) -> Property)
-> ([StateEvent SimpleTx] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[StateEvent SimpleTx]
events ->
        IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
          (EventSource (StateEvent SimpleTx) IO
 -> EventSink (StateEvent SimpleTx) IO -> IO Property)
-> IO Property
forall b.
(EventSource (StateEvent SimpleTx) IO
 -> EventSink (StateEvent SimpleTx) IO -> IO b)
-> IO b
withEventSourceAndSink ((EventSource (StateEvent SimpleTx) IO
  -> EventSink (StateEvent SimpleTx) IO -> IO Property)
 -> IO Property)
-> (EventSource (StateEvent SimpleTx) IO
    -> EventSink (StateEvent SimpleTx) IO -> IO Property)
-> IO Property
forall a b. (a -> b) -> a -> b
$ \EventSource (StateEvent SimpleTx) IO
src EventSink{HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
$sel:putEvent:EventSink :: forall e (m :: * -> *). EventSink e m -> HasEventId e => e -> m ()
putEvent :: HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
putEvent} -> do
            [StateEvent SimpleTx] -> (StateEvent SimpleTx -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [StateEvent SimpleTx]
events HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
StateEvent SimpleTx -> IO ()
putEvent
            [StateEvent SimpleTx]
loadedEvents <- EventSource (StateEvent SimpleTx) IO -> IO [StateEvent SimpleTx]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents EventSource (StateEvent SimpleTx) IO
src
            Property -> IO Property
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$
              [StateEvent SimpleTx]
loadedEvents [StateEvent SimpleTx] -> [StateEvent SimpleTx] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [StateEvent SimpleTx]
events

    FilePath -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
FilePath -> prop -> Spec
prop FilePath
"can handle non-continuous events" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Gen [StateEvent SimpleTx]
-> ([StateEvent SimpleTx] -> [[StateEvent SimpleTx]])
-> ([StateEvent SimpleTx] -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink ([StateEvent SimpleTx] -> Gen [StateEvent SimpleTx]
forall a. [a] -> Gen [a]
sublistOf ([StateEvent SimpleTx] -> Gen [StateEvent SimpleTx])
-> Gen [StateEvent SimpleTx] -> Gen [StateEvent SimpleTx]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen [StateEvent SimpleTx]
genContinuousEvents) [StateEvent SimpleTx] -> [[StateEvent SimpleTx]]
forall a. Arbitrary a => a -> [a]
shrink (([StateEvent SimpleTx] -> Property) -> Property)
-> ([StateEvent SimpleTx] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[StateEvent SimpleTx]
events ->
        IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
          (EventSource (StateEvent SimpleTx) IO
 -> EventSink (StateEvent SimpleTx) IO -> IO Property)
-> IO Property
forall b.
(EventSource (StateEvent SimpleTx) IO
 -> EventSink (StateEvent SimpleTx) IO -> IO b)
-> IO b
withEventSourceAndSink ((EventSource (StateEvent SimpleTx) IO
  -> EventSink (StateEvent SimpleTx) IO -> IO Property)
 -> IO Property)
-> (EventSource (StateEvent SimpleTx) IO
    -> EventSink (StateEvent SimpleTx) IO -> IO Property)
-> IO Property
forall a b. (a -> b) -> a -> b
$ \EventSource (StateEvent SimpleTx) IO
src EventSink{HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
$sel:putEvent:EventSink :: forall e (m :: * -> *). EventSink e m -> HasEventId e => e -> m ()
putEvent :: HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
putEvent} -> do
            [StateEvent SimpleTx] -> (StateEvent SimpleTx -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [StateEvent SimpleTx]
events HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
StateEvent SimpleTx -> IO ()
putEvent
            [StateEvent SimpleTx]
loadedEvents <- EventSource (StateEvent SimpleTx) IO -> IO [StateEvent SimpleTx]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents EventSource (StateEvent SimpleTx) IO
src
            Property -> IO Property
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$
              [StateEvent SimpleTx]
loadedEvents [StateEvent SimpleTx] -> [StateEvent SimpleTx] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [StateEvent SimpleTx]
events

    FilePath -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
FilePath -> prop -> Spec
prop FilePath
"can handle duplicate events" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Gen [StateEvent SimpleTx]
-> ([StateEvent SimpleTx] -> [[StateEvent SimpleTx]])
-> ([StateEvent SimpleTx] -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen [StateEvent SimpleTx]
genContinuousEvents [StateEvent SimpleTx] -> [[StateEvent SimpleTx]]
forall a. Arbitrary a => a -> [a]
shrink (([StateEvent SimpleTx] -> Property) -> Property)
-> ([StateEvent SimpleTx] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[StateEvent SimpleTx]
events ->
        IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$
          (EventSource (StateEvent SimpleTx) IO
 -> EventSink (StateEvent SimpleTx) IO -> IO Property)
-> IO Property
forall b.
(EventSource (StateEvent SimpleTx) IO
 -> EventSink (StateEvent SimpleTx) IO -> IO b)
-> IO b
withEventSourceAndSink ((EventSource (StateEvent SimpleTx) IO
  -> EventSink (StateEvent SimpleTx) IO -> IO Property)
 -> IO Property)
-> (EventSource (StateEvent SimpleTx) IO
    -> EventSink (StateEvent SimpleTx) IO -> IO Property)
-> IO Property
forall a b. (a -> b) -> a -> b
$ \EventSource (StateEvent SimpleTx) IO
src EventSink{HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
$sel:putEvent:EventSink :: forall e (m :: * -> *). EventSink e m -> HasEventId e => e -> m ()
putEvent :: HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
putEvent} -> do
            -- Put some events
            [StateEvent SimpleTx] -> (StateEvent SimpleTx -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [StateEvent SimpleTx]
events HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
StateEvent SimpleTx -> IO ()
putEvent
            [StateEvent SimpleTx]
loadedEvents <- EventSource (StateEvent SimpleTx) IO -> IO [StateEvent SimpleTx]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents EventSource (StateEvent SimpleTx) IO
src
            -- Put the loaded events again (as the node would do)
            [StateEvent SimpleTx] -> (StateEvent SimpleTx -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [StateEvent SimpleTx]
loadedEvents HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
StateEvent SimpleTx -> IO ()
putEvent
            [StateEvent SimpleTx]
allEvents <- EventSource (StateEvent SimpleTx) IO -> IO [StateEvent SimpleTx]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents EventSource (StateEvent SimpleTx) IO
src
            Property -> IO Property
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$
              [StateEvent SimpleTx]
allEvents [StateEvent SimpleTx] -> [StateEvent SimpleTx] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [StateEvent SimpleTx]
loadedEvents

    FilePath -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
FilePath -> prop -> Spec
prop FilePath
"can bootstrap from plain StateChanged events" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Gen [StateEvent SimpleTx]
-> ([StateEvent SimpleTx] -> [[StateEvent SimpleTx]])
-> ([StateEvent SimpleTx] -> Property)
-> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> [a]) -> (a -> prop) -> Property
forAllShrink Gen [StateEvent SimpleTx]
genContinuousEvents [StateEvent SimpleTx] -> [[StateEvent SimpleTx]]
forall a. Arbitrary a => a -> [a]
shrink (([StateEvent SimpleTx] -> Property) -> Property)
-> ([StateEvent SimpleTx] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[StateEvent SimpleTx]
events -> do
        IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO Property -> Property) -> IO Property -> Property
forall a b. (a -> b) -> a -> b
$ do
          FilePath -> (FilePath -> IO Property) -> IO Property
forall (m :: * -> *) r.
MonadIO m =>
FilePath -> (FilePath -> m r) -> m r
withTempDir FilePath
"hydra-persistence" ((FilePath -> IO Property) -> IO Property)
-> (FilePath -> IO Property) -> IO Property
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpDir -> do
            -- Store state changes directly (legacy)
            let stateChanges :: [StateChanged SimpleTx]
stateChanges = (StateEvent SimpleTx -> StateChanged SimpleTx)
-> [StateEvent SimpleTx] -> [StateChanged SimpleTx]
forall a b. (a -> b) -> [a] -> [b]
map StateEvent SimpleTx -> StateChanged SimpleTx
forall tx. StateEvent tx -> StateChanged tx
stateChanged [StateEvent SimpleTx]
events
            PersistenceIncremental{ToJSON (StateChanged SimpleTx) => StateChanged SimpleTx -> IO ()
append :: ToJSON (StateChanged SimpleTx) => StateChanged SimpleTx -> IO ()
$sel:append:PersistenceIncremental :: forall a (m :: * -> *).
PersistenceIncremental a m -> ToJSON a => a -> m ()
append} <- FilePath -> IO (PersistenceIncremental (StateChanged SimpleTx) IO)
forall a (m :: * -> *).
(MonadUnliftIO m, MonadThrow m, FromJSON a) =>
FilePath -> m (PersistenceIncremental a m)
createPersistenceIncremental (FilePath
tmpDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/data")
            [StateChanged SimpleTx]
-> (StateChanged SimpleTx -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [StateChanged SimpleTx]
stateChanges ToJSON (StateChanged SimpleTx) => StateChanged SimpleTx -> IO ()
StateChanged SimpleTx -> IO ()
append
            -- Load and store events through the event source interface
            (EventSource (StateEvent SimpleTx) IO
src, EventSink{HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
$sel:putEvent:EventSink :: forall e (m :: * -> *). EventSink e m -> HasEventId e => e -> m ()
putEvent :: HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
putEvent}) <-
              PersistenceIncremental (PersistedStateChange SimpleTx) IO
-> IO
     (EventSource (StateEvent SimpleTx) IO,
      EventSink (StateEvent SimpleTx) IO)
forall tx (m :: * -> *).
(IsChainState tx, MonadSTM m) =>
PersistenceIncremental (PersistedStateChange tx) m
-> m (EventSource (StateEvent tx) m, EventSink (StateEvent tx) m)
eventPairFromPersistenceIncremental
                (PersistenceIncremental (PersistedStateChange SimpleTx) IO
 -> IO
      (EventSource (StateEvent SimpleTx) IO,
       EventSink (StateEvent SimpleTx) IO))
-> IO (PersistenceIncremental (PersistedStateChange SimpleTx) IO)
-> IO
     (EventSource (StateEvent SimpleTx) IO,
      EventSink (StateEvent SimpleTx) IO)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath
-> IO (PersistenceIncremental (PersistedStateChange SimpleTx) IO)
forall a (m :: * -> *).
(MonadUnliftIO m, MonadThrow m, FromJSON a) =>
FilePath -> m (PersistenceIncremental a m)
createPersistenceIncremental (FilePath
tmpDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/data")
            [StateEvent SimpleTx]
loadedEvents <- EventSource (StateEvent SimpleTx) IO -> IO [StateEvent SimpleTx]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents EventSource (StateEvent SimpleTx) IO
src
            -- Store all loaded events like the node would do
            [StateEvent SimpleTx] -> (StateEvent SimpleTx -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [StateEvent SimpleTx]
loadedEvents HasEventId (StateEvent SimpleTx) => StateEvent SimpleTx -> IO ()
StateEvent SimpleTx -> IO ()
putEvent
            Property -> IO Property
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> IO Property) -> Property -> IO Property
forall a b. (a -> b) -> a -> b
$
              (StateEvent SimpleTx -> StateChanged SimpleTx)
-> [StateEvent SimpleTx] -> [StateChanged SimpleTx]
forall a b. (a -> b) -> [a] -> [b]
map StateEvent SimpleTx -> StateChanged SimpleTx
forall tx. StateEvent tx -> StateChanged tx
stateChanged [StateEvent SimpleTx]
loadedEvents [StateChanged SimpleTx] -> [StateChanged SimpleTx] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [StateChanged SimpleTx]
stateChanges

genContinuousEvents :: Gen [StateEvent SimpleTx]
genContinuousEvents :: Gen [StateEvent SimpleTx]
genContinuousEvents =
  (EventId -> StateChanged SimpleTx -> StateEvent SimpleTx)
-> [EventId] -> [StateChanged SimpleTx] -> [StateEvent SimpleTx]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith EventId -> StateChanged SimpleTx -> StateEvent SimpleTx
forall tx. EventId -> StateChanged tx -> StateEvent tx
StateEvent [EventId
0 ..] ([StateChanged SimpleTx] -> [StateEvent SimpleTx])
-> Gen [StateChanged SimpleTx] -> Gen [StateEvent SimpleTx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (StateChanged SimpleTx) -> Gen [StateChanged SimpleTx]
forall a. Gen a -> Gen [a]
listOf Gen (StateChanged SimpleTx)
forall a. Arbitrary a => Gen a
arbitrary

withEventSourceAndSink :: (EventSource (StateEvent SimpleTx) IO -> EventSink (StateEvent SimpleTx) IO -> IO b) -> IO b
withEventSourceAndSink :: forall b.
(EventSource (StateEvent SimpleTx) IO
 -> EventSink (StateEvent SimpleTx) IO -> IO b)
-> IO b
withEventSourceAndSink EventSource (StateEvent SimpleTx) IO
-> EventSink (StateEvent SimpleTx) IO -> IO b
action =
  FilePath -> (FilePath -> IO b) -> IO b
forall (m :: * -> *) r.
MonadIO m =>
FilePath -> (FilePath -> m r) -> m r
withTempDir FilePath
"hydra-persistence" ((FilePath -> IO b) -> IO b) -> (FilePath -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \FilePath
tmpDir -> do
    (EventSource (StateEvent SimpleTx) IO
eventSource, EventSink (StateEvent SimpleTx) IO
eventSink) <-
      PersistenceIncremental (PersistedStateChange SimpleTx) IO
-> IO
     (EventSource (StateEvent SimpleTx) IO,
      EventSink (StateEvent SimpleTx) IO)
forall tx (m :: * -> *).
(IsChainState tx, MonadSTM m) =>
PersistenceIncremental (PersistedStateChange tx) m
-> m (EventSource (StateEvent tx) m, EventSink (StateEvent tx) m)
eventPairFromPersistenceIncremental
        (PersistenceIncremental (PersistedStateChange SimpleTx) IO
 -> IO
      (EventSource (StateEvent SimpleTx) IO,
       EventSink (StateEvent SimpleTx) IO))
-> IO (PersistenceIncremental (PersistedStateChange SimpleTx) IO)
-> IO
     (EventSource (StateEvent SimpleTx) IO,
      EventSink (StateEvent SimpleTx) IO)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath
-> IO (PersistenceIncremental (PersistedStateChange SimpleTx) IO)
forall a (m :: * -> *).
(MonadUnliftIO m, MonadThrow m, FromJSON a) =>
FilePath -> m (PersistenceIncremental a m)
createPersistenceIncremental (FilePath
tmpDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/data")
    EventSource (StateEvent SimpleTx) IO
-> EventSink (StateEvent SimpleTx) IO -> IO b
action EventSource (StateEvent SimpleTx) IO
eventSource EventSink (StateEvent SimpleTx) IO
eventSink