module Hydra.Events.FileBasedSpec where
import Hydra.Prelude hiding (label)
import Test.Hydra.Prelude
import Hydra.Chain.Direct.State ()
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
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 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{HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
$sel:getEvents:EventSource :: forall e (m :: * -> *). EventSource e m -> HasEventId e => m [e]
getEvents :: HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
getEvents} 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 <- IO [StateEvent SimpleTx]
HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
getEvents
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{HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
$sel:getEvents:EventSource :: forall e (m :: * -> *). EventSource e m -> HasEventId e => m [e]
getEvents :: HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
getEvents} 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 <- IO [StateEvent SimpleTx]
HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
getEvents
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{HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
$sel:getEvents:EventSource :: forall e (m :: * -> *). EventSource e m -> HasEventId e => m [e]
getEvents :: HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
getEvents} 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 <- IO [StateEvent SimpleTx]
HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
getEvents
[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 <- IO [StateEvent SimpleTx]
HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
getEvents
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
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 :: * -> *).
(MonadIO m, MonadThrow m, MonadSTM m, MonadThread m,
MonadThrow (STM m)) =>
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
(EventSource{HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
$sel:getEvents:EventSource :: forall e (m :: * -> *). EventSource e m -> HasEventId e => m [e]
getEvents :: HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
getEvents}, 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 :: * -> *).
(MonadIO m, MonadThrow m, MonadSTM m, MonadThread m,
MonadThrow (STM m)) =>
FilePath -> m (PersistenceIncremental a m)
createPersistenceIncremental (FilePath
tmpDir FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/data")
[StateEvent SimpleTx]
loadedEvents <- IO [StateEvent SimpleTx]
HasEventId (StateEvent SimpleTx) => IO [StateEvent SimpleTx]
getEvents
[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 :: * -> *).
(MonadIO m, MonadThrow m, MonadSTM m, MonadThread m,
MonadThrow (STM m)) =>
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