module Hydra.Events.RotationSpec where

import Hydra.Prelude
import Test.Hydra.Prelude

import Data.List qualified as List
import Hydra.Chain (OnChainTx (..))
import Hydra.Chain.ChainState (ChainSlot (..), IsChainState)
import Hydra.Events (EventSink (..), HasEventId (..), getEvents)
import Hydra.Events.Rotation (EventStore (..), RotationConfig (..), newRotatedEventStore)
import Hydra.HeadLogic (HeadState (..), IdleState (..), StateChanged (..), aggregate)
import Hydra.HeadLogic.StateEvent (StateEvent (..), mkCheckpoint)
import Hydra.Ledger.Simple (SimpleChainState (..), simpleLedger)
import Hydra.Logging (showLogsOnFailure)
import Hydra.Node (hydrate)
import Hydra.NodeSpec (createMockEventStore, inputsToOpenHead, notConnect, observationInput, primeWith, runToCompletion)
import Hydra.Tx.ContestationPeriod (toNominalDiffTime)
import Test.Hydra.Node.Fixture (testEnvironment, testHeadId)
import Test.Hydra.Tx.Fixture (cperiod)
import Test.QuickCheck (Positive (..))
import Test.QuickCheck.Instances.Natural ()

spec :: Spec
spec :: Spec
spec = Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Log rotation" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    -- Set up a hydrate function with fixtures curried
    let setupHydrate :: ((EventStore (StateEvent SimpleTx) m
  -> [EventSink (StateEvent SimpleTx) m]
  -> m (DraftHydraNode SimpleTx m))
 -> m a)
-> m a
setupHydrate (EventStore (StateEvent SimpleTx) m
 -> [EventSink (StateEvent SimpleTx) m]
 -> m (DraftHydraNode SimpleTx m))
-> m a
action =
          Text -> (Tracer m (HydraNodeLog SimpleTx) -> m a) -> m a
forall (m :: * -> *) msg a.
(MonadSTM m, MonadCatch m, MonadFork m, MonadTime m, MonadSay m,
 ToJSON msg) =>
Text -> (Tracer m msg -> m a) -> m a
showLogsOnFailure Text
"RotationSpec" ((Tracer m (HydraNodeLog SimpleTx) -> m a) -> m a)
-> (Tracer m (HydraNodeLog SimpleTx) -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Tracer m (HydraNodeLog SimpleTx)
tracer -> do
            let testHydrate :: EventStore (StateEvent SimpleTx) m
-> [EventSink (StateEvent SimpleTx) m]
-> m (DraftHydraNode SimpleTx m)
testHydrate = Tracer m (HydraNodeLog SimpleTx)
-> Environment
-> Ledger SimpleTx
-> ChainStateType SimpleTx
-> EventStore (StateEvent SimpleTx) m
-> [EventSink (StateEvent SimpleTx) m]
-> m (DraftHydraNode SimpleTx m)
forall tx (m :: * -> *).
(IsChainState tx, MonadDelay m, MonadLabelledSTM m, MonadAsync m,
 MonadThrow m, MonadUnliftIO m) =>
Tracer m (HydraNodeLog tx)
-> Environment
-> Ledger tx
-> ChainStateType tx
-> EventStore (StateEvent tx) m
-> [EventSink (StateEvent tx) m]
-> m (DraftHydraNode tx m)
hydrate Tracer m (HydraNodeLog SimpleTx)
tracer Environment
testEnvironment Ledger SimpleTx
simpleLedger SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = Natural -> ChainSlot
ChainSlot Natural
0}
            (EventStore (StateEvent SimpleTx) m
 -> [EventSink (StateEvent SimpleTx) m]
 -> m (DraftHydraNode SimpleTx m))
-> m a
action EventStore (StateEvent SimpleTx) m
-> [EventSink (StateEvent SimpleTx) m]
-> m (DraftHydraNode SimpleTx m)
testHydrate
    (((EventStore (StateEvent SimpleTx) IO
   -> [EventSink (StateEvent SimpleTx) IO]
   -> IO (DraftHydraNode SimpleTx IO))
  -> IO ())
 -> IO ())
-> SpecWith
     (EventStore (StateEvent SimpleTx) IO
      -> [EventSink (StateEvent SimpleTx) IO]
      -> IO (DraftHydraNode SimpleTx IO))
-> Spec
forall a. (ActionWith a -> IO ()) -> SpecWith a -> Spec
around ((EventStore (StateEvent SimpleTx) IO
  -> [EventSink (StateEvent SimpleTx) IO]
  -> IO (DraftHydraNode SimpleTx IO))
 -> IO ())
-> IO ()
forall {m :: * -> *} {a}.
(MonadCatch m, MonadFork m, MonadTime m, MonadSay m, MonadDelay m,
 MonadLabelledSTM m, MonadAsync m, MonadUnliftIO m) =>
((EventStore (StateEvent SimpleTx) m
  -> [EventSink (StateEvent SimpleTx) m]
  -> m (DraftHydraNode SimpleTx m))
 -> m a)
-> m a
setupHydrate (SpecWith
   (EventStore (StateEvent SimpleTx) IO
    -> [EventSink (StateEvent SimpleTx) IO]
    -> IO (DraftHydraNode SimpleTx IO))
 -> Spec)
-> SpecWith
     (EventStore (StateEvent SimpleTx) IO
      -> [EventSink (StateEvent SimpleTx) IO]
      -> IO (DraftHydraNode SimpleTx IO))
-> Spec
forall a b. (a -> b) -> a -> b
$ do
      String
-> ((EventStore (StateEvent SimpleTx) IO
     -> [EventSink (StateEvent SimpleTx) IO]
     -> IO (DraftHydraNode SimpleTx IO))
    -> IO ())
-> SpecWith
     (Arg
        ((EventStore (StateEvent SimpleTx) IO
          -> [EventSink (StateEvent SimpleTx) IO]
          -> IO (DraftHydraNode SimpleTx IO))
         -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"rotates while running" (((EventStore (StateEvent SimpleTx) IO
   -> [EventSink (StateEvent SimpleTx) IO]
   -> IO (DraftHydraNode SimpleTx IO))
  -> IO ())
 -> SpecWith
      (Arg
         ((EventStore (StateEvent SimpleTx) IO
           -> [EventSink (StateEvent SimpleTx) IO]
           -> IO (DraftHydraNode SimpleTx IO))
          -> IO ())))
-> ((EventStore (StateEvent SimpleTx) IO
     -> [EventSink (StateEvent SimpleTx) IO]
     -> IO (DraftHydraNode SimpleTx IO))
    -> IO ())
-> SpecWith
     (Arg
        ((EventStore (StateEvent SimpleTx) IO
          -> [EventSink (StateEvent SimpleTx) IO]
          -> IO (DraftHydraNode SimpleTx IO))
         -> IO ()))
forall a b. (a -> b) -> a -> b
$ \EventStore (StateEvent SimpleTx) IO
-> [EventSink (StateEvent SimpleTx) IO]
-> IO (DraftHydraNode SimpleTx IO)
testHydrate -> do
        NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
1 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          EventStore (StateEvent SimpleTx) IO
eventStore <- IO (EventStore (StateEvent SimpleTx) IO)
forall (m :: * -> *) a. MonadLabelledSTM m => m (EventStore a m)
createMockEventStore
          -- NOTE: this is hardcoded to ensure we get a checkpoint + a single event at the end
          let rotationConfig :: RotationConfig
rotationConfig = Natural -> RotationConfig
RotateAfter Natural
4
          let s0 :: HeadState SimpleTx
s0 = IdleState SimpleTx -> HeadState SimpleTx
forall tx. IdleState tx -> HeadState tx
Idle IdleState{$sel:chainState:IdleState :: ChainStateType SimpleTx
chainState = SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = Natural -> ChainSlot
ChainSlot Natural
0}}
          EventStore (StateEvent SimpleTx) IO
rotatingEventStore <- RotationConfig
-> HeadState SimpleTx
-> (HeadState SimpleTx
    -> StateEvent SimpleTx -> HeadState SimpleTx)
-> (HeadState SimpleTx -> Word64 -> UTCTime -> StateEvent SimpleTx)
-> EventStore (StateEvent SimpleTx) IO
-> IO (EventStore (StateEvent SimpleTx) IO)
forall e (m :: * -> *) s.
(HasEventId e, MonadSTM m, MonadUnliftIO m, MonadTime m) =>
RotationConfig
-> s
-> (s -> e -> s)
-> (s -> Word64 -> UTCTime -> e)
-> EventStore e m
-> m (EventStore e m)
newRotatedEventStore RotationConfig
rotationConfig HeadState SimpleTx
s0 HeadState SimpleTx -> StateEvent SimpleTx -> HeadState SimpleTx
forall tx.
IsChainState tx =>
HeadState tx -> StateEvent tx -> HeadState tx
mkAggregator HeadState SimpleTx -> Word64 -> UTCTime -> StateEvent SimpleTx
forall tx. HeadState tx -> Word64 -> UTCTime -> StateEvent tx
mkCheckpoint EventStore (StateEvent SimpleTx) IO
eventStore
          EventStore (StateEvent SimpleTx) IO
-> [EventSink (StateEvent SimpleTx) IO]
-> IO (DraftHydraNode SimpleTx IO)
testHydrate EventStore (StateEvent SimpleTx) IO
rotatingEventStore []
            IO (DraftHydraNode SimpleTx IO)
-> (DraftHydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO))
-> IO (HydraNode SimpleTx IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DraftHydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO)
forall (m :: * -> *) tx.
MonadThrow m =>
DraftHydraNode tx m -> m (HydraNode tx m)
notConnect
            IO (HydraNode SimpleTx IO)
-> (HydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO))
-> IO (HydraNode SimpleTx IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Input SimpleTx]
-> HydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO)
forall (m :: * -> *) tx.
Monad m =>
[Input tx] -> HydraNode tx m -> m (HydraNode tx m)
primeWith [Input SimpleTx]
inputsToOpenHead
            IO (HydraNode SimpleTx IO)
-> (HydraNode SimpleTx IO -> 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
>>= HydraNode SimpleTx IO -> IO ()
forall tx. IsChainState tx => HydraNode tx IO -> IO ()
runToCompletion
          [StateEvent SimpleTx]
rotatedHistory <- EventSource (StateEvent SimpleTx) IO -> IO [StateEvent SimpleTx]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents (EventStore (StateEvent SimpleTx) IO
-> EventSource (StateEvent SimpleTx) IO
forall e (m :: * -> *). EventStore e m -> EventSource e m
eventSource EventStore (StateEvent SimpleTx) IO
rotatingEventStore)
          [StateEvent SimpleTx] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [StateEvent SimpleTx]
rotatedHistory Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Int
2
      String
-> ((EventStore (StateEvent SimpleTx) IO
     -> [EventSink (StateEvent SimpleTx) IO]
     -> IO (DraftHydraNode SimpleTx IO))
    -> IO ())
-> SpecWith
     (Arg
        ((EventStore (StateEvent SimpleTx) IO
          -> [EventSink (StateEvent SimpleTx) IO]
          -> IO (DraftHydraNode SimpleTx IO))
         -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"consistent state after restarting with rotation" (((EventStore (StateEvent SimpleTx) IO
   -> [EventSink (StateEvent SimpleTx) IO]
   -> IO (DraftHydraNode SimpleTx IO))
  -> IO ())
 -> SpecWith
      (Arg
         ((EventStore (StateEvent SimpleTx) IO
           -> [EventSink (StateEvent SimpleTx) IO]
           -> IO (DraftHydraNode SimpleTx IO))
          -> IO ())))
-> ((EventStore (StateEvent SimpleTx) IO
     -> [EventSink (StateEvent SimpleTx) IO]
     -> IO (DraftHydraNode SimpleTx IO))
    -> IO ())
-> SpecWith
     (Arg
        ((EventStore (StateEvent SimpleTx) IO
          -> [EventSink (StateEvent SimpleTx) IO]
          -> IO (DraftHydraNode SimpleTx IO))
         -> IO ()))
forall a b. (a -> b) -> a -> b
$ \EventStore (StateEvent SimpleTx) IO
-> [EventSink (StateEvent SimpleTx) IO]
-> IO (DraftHydraNode SimpleTx IO)
testHydrate -> do
        NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
1 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
          EventStore (StateEvent SimpleTx) IO
eventStore <- IO (EventStore (StateEvent SimpleTx) IO)
forall (m :: * -> *) a. MonadLabelledSTM m => m (EventStore a m)
createMockEventStore
          -- NOTE: this is hardcoded to ensure we get a single checkpoint event at the end
          let rotationConfig :: RotationConfig
rotationConfig = Natural -> RotationConfig
RotateAfter Natural
3
          let s0 :: HeadState SimpleTx
s0 = IdleState SimpleTx -> HeadState SimpleTx
forall tx. IdleState tx -> HeadState tx
Idle IdleState{$sel:chainState:IdleState :: ChainStateType SimpleTx
chainState = SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = Natural -> ChainSlot
ChainSlot Natural
0}}
          EventStore (StateEvent SimpleTx) IO
rotatingEventStore <- RotationConfig
-> HeadState SimpleTx
-> (HeadState SimpleTx
    -> StateEvent SimpleTx -> HeadState SimpleTx)
-> (HeadState SimpleTx -> Word64 -> UTCTime -> StateEvent SimpleTx)
-> EventStore (StateEvent SimpleTx) IO
-> IO (EventStore (StateEvent SimpleTx) IO)
forall e (m :: * -> *) s.
(HasEventId e, MonadSTM m, MonadUnliftIO m, MonadTime m) =>
RotationConfig
-> s
-> (s -> e -> s)
-> (s -> Word64 -> UTCTime -> e)
-> EventStore e m
-> m (EventStore e m)
newRotatedEventStore RotationConfig
rotationConfig HeadState SimpleTx
s0 HeadState SimpleTx -> StateEvent SimpleTx -> HeadState SimpleTx
forall tx.
IsChainState tx =>
HeadState tx -> StateEvent tx -> HeadState tx
mkAggregator HeadState SimpleTx -> Word64 -> UTCTime -> StateEvent SimpleTx
forall tx. HeadState tx -> Word64 -> UTCTime -> StateEvent tx
mkCheckpoint EventStore (StateEvent SimpleTx) IO
eventStore
          EventStore (StateEvent SimpleTx) IO
-> [EventSink (StateEvent SimpleTx) IO]
-> IO (DraftHydraNode SimpleTx IO)
testHydrate EventStore (StateEvent SimpleTx) IO
rotatingEventStore []
            IO (DraftHydraNode SimpleTx IO)
-> (DraftHydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO))
-> IO (HydraNode SimpleTx IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DraftHydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO)
forall (m :: * -> *) tx.
MonadThrow m =>
DraftHydraNode tx m -> m (HydraNode tx m)
notConnect
            IO (HydraNode SimpleTx IO)
-> (HydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO))
-> IO (HydraNode SimpleTx IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Input SimpleTx]
-> HydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO)
forall (m :: * -> *) tx.
Monad m =>
[Input tx] -> HydraNode tx m -> m (HydraNode tx m)
primeWith [Input SimpleTx]
inputsToOpenHead
            IO (HydraNode SimpleTx IO)
-> (HydraNode SimpleTx IO -> 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
>>= HydraNode SimpleTx IO -> IO ()
forall tx. IsChainState tx => HydraNode tx IO -> IO ()
runToCompletion
          UTCTime
now <- IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
          let contestationDeadline :: UTCTime
contestationDeadline = ContestationPeriod -> NominalDiffTime
toNominalDiffTime ContestationPeriod
cperiod NominalDiffTime -> UTCTime -> UTCTime
`addUTCTime` UTCTime
now
          let closeInput :: Input SimpleTx
closeInput = OnChainTx SimpleTx -> Input SimpleTx
observationInput (OnChainTx SimpleTx -> Input SimpleTx)
-> OnChainTx SimpleTx -> Input SimpleTx
forall a b. (a -> b) -> a -> b
$ HeadId -> SnapshotNumber -> UTCTime -> OnChainTx SimpleTx
forall tx. HeadId -> SnapshotNumber -> UTCTime -> OnChainTx tx
OnCloseTx HeadId
testHeadId SnapshotNumber
0 UTCTime
contestationDeadline
          EventStore (StateEvent SimpleTx) IO
-> [EventSink (StateEvent SimpleTx) IO]
-> IO (DraftHydraNode SimpleTx IO)
testHydrate EventStore (StateEvent SimpleTx) IO
rotatingEventStore []
            IO (DraftHydraNode SimpleTx IO)
-> (DraftHydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO))
-> IO (HydraNode SimpleTx IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DraftHydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO)
forall (m :: * -> *) tx.
MonadThrow m =>
DraftHydraNode tx m -> m (HydraNode tx m)
notConnect
            IO (HydraNode SimpleTx IO)
-> (HydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO))
-> IO (HydraNode SimpleTx IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Input SimpleTx]
-> HydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO)
forall (m :: * -> *) tx.
Monad m =>
[Input tx] -> HydraNode tx m -> m (HydraNode tx m)
primeWith [Input SimpleTx
closeInput]
            IO (HydraNode SimpleTx IO)
-> (HydraNode SimpleTx IO -> 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
>>= HydraNode SimpleTx IO -> IO ()
forall tx. IsChainState tx => HydraNode tx IO -> IO ()
runToCompletion
          [StateEvent SimpleTx
checkpoint] <- EventSource (StateEvent SimpleTx) IO -> IO [StateEvent SimpleTx]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents (EventStore (StateEvent SimpleTx) IO
-> EventSource (StateEvent SimpleTx) IO
forall e (m :: * -> *). EventStore e m -> EventSource e m
eventSource EventStore (StateEvent SimpleTx) IO
rotatingEventStore)
          case StateEvent SimpleTx -> StateChanged SimpleTx
forall tx. StateEvent tx -> StateChanged tx
stateChanged StateEvent SimpleTx
checkpoint of
            Checkpoint{$sel:state:NetworkConnected :: forall tx. StateChanged tx -> HeadState tx
state = Closed{}} -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
            StateChanged SimpleTx
_ -> String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"unexpected: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> StateEvent SimpleTx -> String
forall b a. (Show a, IsString b) => a -> b
show StateEvent SimpleTx
checkpoint)
      String
-> ((EventStore (StateEvent SimpleTx) IO
     -> [EventSink (StateEvent SimpleTx) IO]
     -> IO (DraftHydraNode SimpleTx IO))
    -> IO ())
-> SpecWith
     (Arg
        ((EventStore (StateEvent SimpleTx) IO
          -> [EventSink (StateEvent SimpleTx) IO]
          -> IO (DraftHydraNode SimpleTx IO))
         -> IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"a rotated and non-rotated node have consistent state" (((EventStore (StateEvent SimpleTx) IO
   -> [EventSink (StateEvent SimpleTx) IO]
   -> IO (DraftHydraNode SimpleTx IO))
  -> IO ())
 -> SpecWith
      (Arg
         ((EventStore (StateEvent SimpleTx) IO
           -> [EventSink (StateEvent SimpleTx) IO]
           -> IO (DraftHydraNode SimpleTx IO))
          -> IO ())))
-> ((EventStore (StateEvent SimpleTx) IO
     -> [EventSink (StateEvent SimpleTx) IO]
     -> IO (DraftHydraNode SimpleTx IO))
    -> IO ())
-> SpecWith
     (Arg
        ((EventStore (StateEvent SimpleTx) IO
          -> [EventSink (StateEvent SimpleTx) IO]
          -> IO (DraftHydraNode SimpleTx IO))
         -> IO ()))
forall a b. (a -> b) -> a -> b
$ \EventStore (StateEvent SimpleTx) IO
-> [EventSink (StateEvent SimpleTx) IO]
-> IO (DraftHydraNode SimpleTx IO)
testHydrate -> do
        -- prepare inputs
        UTCTime
now <- IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
        let contestationDeadline :: UTCTime
contestationDeadline = ContestationPeriod -> NominalDiffTime
toNominalDiffTime ContestationPeriod
cperiod NominalDiffTime -> UTCTime -> UTCTime
`addUTCTime` UTCTime
now
        let closeInput :: Input SimpleTx
closeInput = OnChainTx SimpleTx -> Input SimpleTx
observationInput (OnChainTx SimpleTx -> Input SimpleTx)
-> OnChainTx SimpleTx -> Input SimpleTx
forall a b. (a -> b) -> a -> b
$ HeadId -> SnapshotNumber -> UTCTime -> OnChainTx SimpleTx
forall tx. HeadId -> SnapshotNumber -> UTCTime -> OnChainTx tx
OnCloseTx HeadId
testHeadId SnapshotNumber
0 UTCTime
contestationDeadline
        let inputs :: [Input SimpleTx]
inputs = [Input SimpleTx]
inputsToOpenHead [Input SimpleTx] -> [Input SimpleTx] -> [Input SimpleTx]
forall a. [a] -> [a] -> [a]
++ [Input SimpleTx
closeInput]
        NominalDiffTime -> IO () -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadTimer m, MonadThrow m) =>
NominalDiffTime -> m a -> m a
failAfter NominalDiffTime
1 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          do
            EventStore (StateEvent SimpleTx) IO
eventStore <- IO (EventStore (StateEvent SimpleTx) IO)
forall (m :: * -> *) a. MonadLabelledSTM m => m (EventStore a m)
createMockEventStore
            -- NOTE: this is hardcoded to ensure we get a single checkpoint event at the end
            let rotationConfig :: RotationConfig
rotationConfig = Natural -> RotationConfig
RotateAfter Natural
3
            -- run rotated event store with prepared inputs
            let s0 :: HeadState SimpleTx
s0 = IdleState SimpleTx -> HeadState SimpleTx
forall tx. IdleState tx -> HeadState tx
Idle IdleState{$sel:chainState:IdleState :: ChainStateType SimpleTx
chainState = SimpleChainState{$sel:slot:SimpleChainState :: ChainSlot
slot = Natural -> ChainSlot
ChainSlot Natural
0}}
            EventStore (StateEvent SimpleTx) IO
rotatingEventStore <- RotationConfig
-> HeadState SimpleTx
-> (HeadState SimpleTx
    -> StateEvent SimpleTx -> HeadState SimpleTx)
-> (HeadState SimpleTx -> Word64 -> UTCTime -> StateEvent SimpleTx)
-> EventStore (StateEvent SimpleTx) IO
-> IO (EventStore (StateEvent SimpleTx) IO)
forall e (m :: * -> *) s.
(HasEventId e, MonadSTM m, MonadUnliftIO m, MonadTime m) =>
RotationConfig
-> s
-> (s -> e -> s)
-> (s -> Word64 -> UTCTime -> e)
-> EventStore e m
-> m (EventStore e m)
newRotatedEventStore RotationConfig
rotationConfig HeadState SimpleTx
s0 HeadState SimpleTx -> StateEvent SimpleTx -> HeadState SimpleTx
forall tx.
IsChainState tx =>
HeadState tx -> StateEvent tx -> HeadState tx
mkAggregator HeadState SimpleTx -> Word64 -> UTCTime -> StateEvent SimpleTx
forall tx. HeadState tx -> Word64 -> UTCTime -> StateEvent tx
mkCheckpoint EventStore (StateEvent SimpleTx) IO
eventStore
            EventStore (StateEvent SimpleTx) IO
-> [EventSink (StateEvent SimpleTx) IO]
-> IO (DraftHydraNode SimpleTx IO)
testHydrate EventStore (StateEvent SimpleTx) IO
rotatingEventStore []
              IO (DraftHydraNode SimpleTx IO)
-> (DraftHydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO))
-> IO (HydraNode SimpleTx IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DraftHydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO)
forall (m :: * -> *) tx.
MonadThrow m =>
DraftHydraNode tx m -> m (HydraNode tx m)
notConnect
              IO (HydraNode SimpleTx IO)
-> (HydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO))
-> IO (HydraNode SimpleTx IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Input SimpleTx]
-> HydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO)
forall (m :: * -> *) tx.
Monad m =>
[Input tx] -> HydraNode tx m -> m (HydraNode tx m)
primeWith [Input SimpleTx]
inputs
              IO (HydraNode SimpleTx IO)
-> (HydraNode SimpleTx IO -> 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
>>= HydraNode SimpleTx IO -> IO ()
forall tx. IsChainState tx => HydraNode tx IO -> IO ()
runToCompletion
            -- run non-rotated event store with prepared inputs
            EventStore (StateEvent SimpleTx) IO
eventStore' <- IO (EventStore (StateEvent SimpleTx) IO)
forall (m :: * -> *) a. MonadLabelledSTM m => m (EventStore a m)
createMockEventStore
            EventStore (StateEvent SimpleTx) IO
-> [EventSink (StateEvent SimpleTx) IO]
-> IO (DraftHydraNode SimpleTx IO)
testHydrate EventStore (StateEvent SimpleTx) IO
eventStore' []
              IO (DraftHydraNode SimpleTx IO)
-> (DraftHydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO))
-> IO (HydraNode SimpleTx IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DraftHydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO)
forall (m :: * -> *) tx.
MonadThrow m =>
DraftHydraNode tx m -> m (HydraNode tx m)
notConnect
              IO (HydraNode SimpleTx IO)
-> (HydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO))
-> IO (HydraNode SimpleTx IO)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [Input SimpleTx]
-> HydraNode SimpleTx IO -> IO (HydraNode SimpleTx IO)
forall (m :: * -> *) tx.
Monad m =>
[Input tx] -> HydraNode tx m -> m (HydraNode tx m)
primeWith [Input SimpleTx]
inputs
              IO (HydraNode SimpleTx IO)
-> (HydraNode SimpleTx IO -> 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
>>= HydraNode SimpleTx IO -> IO ()
forall tx. IsChainState tx => HydraNode tx IO -> IO ()
runToCompletion
            -- aggregating stored events should yield consistent states
            [StateEvent{$sel:stateChanged:StateEvent :: forall tx. StateEvent tx -> StateChanged tx
stateChanged = StateChanged SimpleTx
checkpoint}] <- EventSource (StateEvent SimpleTx) IO -> IO [StateEvent SimpleTx]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents (EventStore (StateEvent SimpleTx) IO
-> EventSource (StateEvent SimpleTx) IO
forall e (m :: * -> *). EventStore e m -> EventSource e m
eventSource EventStore (StateEvent SimpleTx) IO
rotatingEventStore)
            [StateEvent SimpleTx]
events' <- EventSource (StateEvent SimpleTx) IO -> IO [StateEvent SimpleTx]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents (EventStore (StateEvent SimpleTx) IO
-> EventSource (StateEvent SimpleTx) IO
forall e (m :: * -> *). EventStore e m -> EventSource e m
eventSource EventStore (StateEvent SimpleTx) IO
eventStore')
            let checkpoint' :: HeadState SimpleTx
checkpoint' = (HeadState SimpleTx -> StateEvent SimpleTx -> HeadState SimpleTx)
-> HeadState SimpleTx
-> [StateEvent SimpleTx]
-> HeadState SimpleTx
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' HeadState SimpleTx -> StateEvent SimpleTx -> HeadState SimpleTx
forall tx.
IsChainState tx =>
HeadState tx -> StateEvent tx -> HeadState tx
mkAggregator HeadState SimpleTx
s0 [StateEvent SimpleTx]
events'
            StateChanged SimpleTx
checkpoint StateChanged SimpleTx -> StateChanged SimpleTx -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` HeadState SimpleTx -> StateChanged SimpleTx
forall tx. HeadState tx -> StateChanged tx
Checkpoint HeadState SimpleTx
checkpoint'

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Rotation algorithm" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> ((Positive Natural, Positive Natural) -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"rotates on startup" (((Positive Natural, Positive Natural) -> IO ()) -> Spec)
-> ((Positive Natural, Positive Natural) -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
      \(Positive Natural
x, Positive Natural
delta) -> do
        eventStore :: EventStore TrivialEvent IO
eventStore@EventStore{EventSource TrivialEvent IO
$sel:eventSource:EventStore :: forall e (m :: * -> *). EventStore e m -> EventSource e m
eventSource :: EventSource TrivialEvent IO
eventSource, EventSink TrivialEvent IO
eventSink :: EventSink TrivialEvent IO
$sel:eventSink:EventStore :: forall e (m :: * -> *). EventStore e m -> EventSink e m
eventSink} <- IO (EventStore TrivialEvent IO)
forall (m :: * -> *) a. MonadLabelledSTM m => m (EventStore a m)
createMockEventStore
        let y :: Natural
y = Natural
x Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
delta
        let totalEvents :: Integer
totalEvents = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
y
        let events :: [TrivialEvent]
events = Word64 -> TrivialEvent
TrivialEvent (Word64 -> TrivialEvent) -> [Word64] -> [TrivialEvent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word64
1 .. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
totalEvents]
        (TrivialEvent -> IO ()) -> [TrivialEvent] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (EventSink TrivialEvent IO
-> HasEventId TrivialEvent => TrivialEvent -> IO ()
forall e (m :: * -> *). EventSink e m -> HasEventId e => e -> m ()
putEvent EventSink TrivialEvent IO
eventSink) [TrivialEvent]
events
        [TrivialEvent]
unrotatedHistory <- EventSource TrivialEvent IO -> IO [TrivialEvent]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents EventSource TrivialEvent IO
eventSource
        Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([TrivialEvent] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TrivialEvent]
unrotatedHistory) Integer -> Integer -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Integer
totalEvents
        let rotationConfig :: RotationConfig
rotationConfig = Natural -> RotationConfig
RotateAfter Natural
x
        let s0 :: [a]
s0 = []
        let aggregator :: [a] -> a -> [a]
aggregator [a]
s a
e = a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
s
        let checkpointer :: [TrivialEvent] -> p -> p -> TrivialEvent
checkpointer [TrivialEvent]
s p
_ p
_ = [TrivialEvent] -> TrivialEvent
trivialCheckpoint [TrivialEvent]
s
        EventStore{$sel:eventSource:EventStore :: forall e (m :: * -> *). EventStore e m -> EventSource e m
eventSource = EventSource TrivialEvent IO
rotatedEventSource} <- RotationConfig
-> [TrivialEvent]
-> ([TrivialEvent] -> TrivialEvent -> [TrivialEvent])
-> ([TrivialEvent] -> Word64 -> UTCTime -> TrivialEvent)
-> EventStore TrivialEvent IO
-> IO (EventStore TrivialEvent IO)
forall e (m :: * -> *) s.
(HasEventId e, MonadSTM m, MonadUnliftIO m, MonadTime m) =>
RotationConfig
-> s
-> (s -> e -> s)
-> (s -> Word64 -> UTCTime -> e)
-> EventStore e m
-> m (EventStore e m)
newRotatedEventStore RotationConfig
rotationConfig [TrivialEvent]
forall a. [a]
s0 [TrivialEvent] -> TrivialEvent -> [TrivialEvent]
forall {a}. [a] -> a -> [a]
aggregator [TrivialEvent] -> Word64 -> UTCTime -> TrivialEvent
forall {p} {p}. [TrivialEvent] -> p -> p -> TrivialEvent
checkpointer EventStore TrivialEvent IO
eventStore
        [TrivialEvent]
rotatedHistory <- EventSource TrivialEvent IO -> IO [TrivialEvent]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents EventSource TrivialEvent IO
rotatedEventSource
        [TrivialEvent] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TrivialEvent]
rotatedHistory Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Int
1

    -- given some event store (source + sink)
    -- lets configure a rotated event store that rotates after x events
    -- forall y > 0: put x*y events
    -- load all events returns a suffix of put events with length <= x
    String -> ((Positive Natural, Positive Integer) -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"rotates after configured number of events" (((Positive Natural, Positive Integer) -> IO ()) -> Spec)
-> ((Positive Natural, Positive Integer) -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
      \(Positive Natural
x, Positive Integer
y) -> do
        EventStore TrivialEvent IO
mockEventStore <- IO (EventStore TrivialEvent IO)
forall (m :: * -> *) a. MonadLabelledSTM m => m (EventStore a m)
createMockEventStore
        let rotationConfig :: RotationConfig
rotationConfig = Natural -> RotationConfig
RotateAfter Natural
x
        let s0 :: [a]
s0 = []
        let aggregator :: [a] -> a -> [a]
aggregator [a]
s a
e = a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
s
        let checkpointer :: [TrivialEvent] -> p -> p -> TrivialEvent
checkpointer [TrivialEvent]
s p
_ p
_ = [TrivialEvent] -> TrivialEvent
trivialCheckpoint [TrivialEvent]
s
        EventStore TrivialEvent IO
rotatingEventStore <- RotationConfig
-> [TrivialEvent]
-> ([TrivialEvent] -> TrivialEvent -> [TrivialEvent])
-> ([TrivialEvent] -> Word64 -> UTCTime -> TrivialEvent)
-> EventStore TrivialEvent IO
-> IO (EventStore TrivialEvent IO)
forall e (m :: * -> *) s.
(HasEventId e, MonadSTM m, MonadUnliftIO m, MonadTime m) =>
RotationConfig
-> s
-> (s -> e -> s)
-> (s -> Word64 -> UTCTime -> e)
-> EventStore e m
-> m (EventStore e m)
newRotatedEventStore RotationConfig
rotationConfig [TrivialEvent]
forall a. [a]
s0 [TrivialEvent] -> TrivialEvent -> [TrivialEvent]
forall {a}. [a] -> a -> [a]
aggregator [TrivialEvent] -> Word64 -> UTCTime -> TrivialEvent
forall {p} {p}. [TrivialEvent] -> p -> p -> TrivialEvent
checkpointer EventStore TrivialEvent IO
mockEventStore
        let EventStore{EventSource TrivialEvent IO
$sel:eventSource:EventStore :: forall e (m :: * -> *). EventStore e m -> EventSource e m
eventSource :: EventSource TrivialEvent IO
eventSource, $sel:eventSink:EventStore :: forall e (m :: * -> *). EventStore e m -> EventSink e m
eventSink = EventSink{HasEventId TrivialEvent => TrivialEvent -> IO ()
$sel:putEvent:EventSink :: forall e (m :: * -> *). EventSink e m -> HasEventId e => e -> m ()
putEvent :: HasEventId TrivialEvent => TrivialEvent -> IO ()
putEvent}} = EventStore TrivialEvent IO
rotatingEventStore
        let totalEvents :: Integer
totalEvents = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
y
        let events :: [TrivialEvent]
events = Word64 -> TrivialEvent
TrivialEvent (Word64 -> TrivialEvent)
-> (Integer -> Word64) -> Integer -> TrivialEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> TrivialEvent) -> [Integer] -> [TrivialEvent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer
1 .. Integer
totalEvents]
        [TrivialEvent] -> (TrivialEvent -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TrivialEvent]
events HasEventId TrivialEvent => TrivialEvent -> IO ()
TrivialEvent -> IO ()
putEvent
        [TrivialEvent]
currentHistory <- EventSource TrivialEvent IO -> IO [TrivialEvent]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents EventSource TrivialEvent IO
eventSource
        let rotatedElements :: Int
rotatedElements = Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
totalEvents
        let expectRotated :: [TrivialEvent]
expectRotated = Int -> [TrivialEvent] -> [TrivialEvent]
forall a. Int -> [a] -> [a]
take Int
rotatedElements [TrivialEvent]
events
        let expectRemaining :: [TrivialEvent]
expectRemaining = Int -> [TrivialEvent] -> [TrivialEvent]
forall a. Int -> [a] -> [a]
drop Int
rotatedElements [TrivialEvent]
events
        let expectedCurrentHistory :: [TrivialEvent]
expectedCurrentHistory = [TrivialEvent] -> TrivialEvent
trivialCheckpoint [TrivialEvent]
expectRotated TrivialEvent -> [TrivialEvent] -> [TrivialEvent]
forall a. a -> [a] -> [a]
: [TrivialEvent]
expectRemaining
        [TrivialEvent]
expectedCurrentHistory [TrivialEvent] -> [TrivialEvent] -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` [TrivialEvent]
currentHistory

    -- forall y. y > 0 && y < x: put x+y events (= ensures rotation)
    -- load one event === checkpoint of first x of events
    String -> ((Positive Natural, Positive Natural) -> IO ()) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"puts checkpoint event as first event" (((Positive Natural, Positive Natural) -> IO ()) -> Spec)
-> ((Positive Natural, Positive Natural) -> IO ()) -> Spec
forall a b. (a -> b) -> a -> b
$
      \(Positive Natural
y, Positive Natural
delta) -> do
        let x :: Natural
x = Natural
y Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
delta
        EventStore TrivialEvent IO
mockEventStore <- IO (EventStore TrivialEvent IO)
forall (m :: * -> *) a. MonadLabelledSTM m => m (EventStore a m)
createMockEventStore
        let rotationConfig :: RotationConfig
rotationConfig = Natural -> RotationConfig
RotateAfter Natural
x
        let s0 :: [a]
s0 = []
        let aggregator :: [a] -> a -> [a]
aggregator [a]
s a
e = a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
s
        let checkpointer :: [TrivialEvent] -> p -> p -> TrivialEvent
checkpointer [TrivialEvent]
s p
_ p
_ = [TrivialEvent] -> TrivialEvent
trivialCheckpoint [TrivialEvent]
s
        EventStore TrivialEvent IO
rotatingEventStore <- RotationConfig
-> [TrivialEvent]
-> ([TrivialEvent] -> TrivialEvent -> [TrivialEvent])
-> ([TrivialEvent] -> Word64 -> UTCTime -> TrivialEvent)
-> EventStore TrivialEvent IO
-> IO (EventStore TrivialEvent IO)
forall e (m :: * -> *) s.
(HasEventId e, MonadSTM m, MonadUnliftIO m, MonadTime m) =>
RotationConfig
-> s
-> (s -> e -> s)
-> (s -> Word64 -> UTCTime -> e)
-> EventStore e m
-> m (EventStore e m)
newRotatedEventStore RotationConfig
rotationConfig [TrivialEvent]
forall a. [a]
s0 [TrivialEvent] -> TrivialEvent -> [TrivialEvent]
forall {a}. [a] -> a -> [a]
aggregator [TrivialEvent] -> Word64 -> UTCTime -> TrivialEvent
forall {p} {p}. [TrivialEvent] -> p -> p -> TrivialEvent
checkpointer EventStore TrivialEvent IO
mockEventStore
        let EventStore{EventSource TrivialEvent IO
$sel:eventSource:EventStore :: forall e (m :: * -> *). EventStore e m -> EventSource e m
eventSource :: EventSource TrivialEvent IO
eventSource, $sel:eventSink:EventStore :: forall e (m :: * -> *). EventStore e m -> EventSink e m
eventSink = EventSink{HasEventId TrivialEvent => TrivialEvent -> IO ()
$sel:putEvent:EventSink :: forall e (m :: * -> *). EventSink e m -> HasEventId e => e -> m ()
putEvent :: HasEventId TrivialEvent => TrivialEvent -> IO ()
putEvent}} = EventStore TrivialEvent IO
rotatingEventStore
        let totalEvents :: Integer
totalEvents = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
x Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
y
        let events :: [TrivialEvent]
events = Word64 -> TrivialEvent
TrivialEvent (Word64 -> TrivialEvent)
-> (Integer -> Word64) -> Integer -> TrivialEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> TrivialEvent) -> [Integer] -> [TrivialEvent]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer
1 .. Integer
totalEvents]
        [TrivialEvent] -> (TrivialEvent -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [TrivialEvent]
events HasEventId TrivialEvent => TrivialEvent -> IO ()
TrivialEvent -> IO ()
putEvent
        [TrivialEvent]
currentHistory <- EventSource TrivialEvent IO -> IO [TrivialEvent]
forall e (m :: * -> *).
(HasEventId e, MonadUnliftIO m) =>
EventSource e m -> m [e]
getEvents EventSource TrivialEvent IO
eventSource
        let expectRotated :: [TrivialEvent]
expectRotated = Int -> [TrivialEvent] -> [TrivialEvent]
forall a. Int -> [a] -> [a]
take (Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
x) [TrivialEvent]
events
        [TrivialEvent] -> TrivialEvent
trivialCheckpoint [TrivialEvent]
expectRotated TrivialEvent -> TrivialEvent -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` [TrivialEvent] -> TrivialEvent
forall a. HasCallStack => [a] -> a
List.head [TrivialEvent]
currentHistory

newtype TrivialEvent = TrivialEvent Word64
  deriving newtype (Integer -> TrivialEvent
TrivialEvent -> TrivialEvent
TrivialEvent -> TrivialEvent -> TrivialEvent
(TrivialEvent -> TrivialEvent -> TrivialEvent)
-> (TrivialEvent -> TrivialEvent -> TrivialEvent)
-> (TrivialEvent -> TrivialEvent -> TrivialEvent)
-> (TrivialEvent -> TrivialEvent)
-> (TrivialEvent -> TrivialEvent)
-> (TrivialEvent -> TrivialEvent)
-> (Integer -> TrivialEvent)
-> Num TrivialEvent
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: TrivialEvent -> TrivialEvent -> TrivialEvent
+ :: TrivialEvent -> TrivialEvent -> TrivialEvent
$c- :: TrivialEvent -> TrivialEvent -> TrivialEvent
- :: TrivialEvent -> TrivialEvent -> TrivialEvent
$c* :: TrivialEvent -> TrivialEvent -> TrivialEvent
* :: TrivialEvent -> TrivialEvent -> TrivialEvent
$cnegate :: TrivialEvent -> TrivialEvent
negate :: TrivialEvent -> TrivialEvent
$cabs :: TrivialEvent -> TrivialEvent
abs :: TrivialEvent -> TrivialEvent
$csignum :: TrivialEvent -> TrivialEvent
signum :: TrivialEvent -> TrivialEvent
$cfromInteger :: Integer -> TrivialEvent
fromInteger :: Integer -> TrivialEvent
Num, Int -> TrivialEvent -> String -> String
[TrivialEvent] -> String -> String
TrivialEvent -> String
(Int -> TrivialEvent -> String -> String)
-> (TrivialEvent -> String)
-> ([TrivialEvent] -> String -> String)
-> Show TrivialEvent
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> TrivialEvent -> String -> String
showsPrec :: Int -> TrivialEvent -> String -> String
$cshow :: TrivialEvent -> String
show :: TrivialEvent -> String
$cshowList :: [TrivialEvent] -> String -> String
showList :: [TrivialEvent] -> String -> String
Show, TrivialEvent -> TrivialEvent -> Bool
(TrivialEvent -> TrivialEvent -> Bool)
-> (TrivialEvent -> TrivialEvent -> Bool) -> Eq TrivialEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TrivialEvent -> TrivialEvent -> Bool
== :: TrivialEvent -> TrivialEvent -> Bool
$c/= :: TrivialEvent -> TrivialEvent -> Bool
/= :: TrivialEvent -> TrivialEvent -> Bool
Eq)

instance HasEventId TrivialEvent where
  getEventId :: TrivialEvent -> Word64
getEventId (TrivialEvent Word64
w) = Word64
w

trivialCheckpoint :: [TrivialEvent] -> TrivialEvent
trivialCheckpoint :: [TrivialEvent] -> TrivialEvent
trivialCheckpoint = [TrivialEvent] -> TrivialEvent
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum

mkAggregator :: IsChainState tx => HeadState tx -> StateEvent tx -> HeadState tx
mkAggregator :: forall tx.
IsChainState tx =>
HeadState tx -> StateEvent tx -> HeadState tx
mkAggregator HeadState tx
s StateEvent{StateChanged tx
$sel:stateChanged:StateEvent :: forall tx. StateEvent tx -> StateChanged tx
stateChanged :: StateChanged tx
stateChanged} = HeadState tx -> StateChanged tx -> HeadState tx
forall tx.
IsChainState tx =>
HeadState tx -> StateChanged tx -> HeadState tx
aggregate HeadState tx
s StateChanged tx
stateChanged