{-# LANGUAGE UndecidableInstances #-}

-- | This module defines the types and functions for creating 'EventSource' and
-- 'EventSink' instances and is intended to be used as an extension point.
--
-- A single 'EventSource' and zero or more 'EventSink' handles are used by the
-- main 'HydraNode' handle to load and send out events.
--
-- See 'Hydra.Events.FileBased' for an example implementation and
-- 'Hydra.Events.FileBasedSpec' for the corresponding test suite.
--
-- Custom implementations should be located under Hydra.Events to avoid
-- conflicts.
module Hydra.Events where

import Hydra.Prelude

import Hydra.Chain.ChainState (IsChainState)
import Hydra.HeadLogic.Outcome (StateChanged)
import Hydra.Tx.IsTx (ArbitraryIsTx)
import Test.QuickCheck.Arbitrary.ADT (ToADTArbitrary)

type EventId = Word64

class HasEventId a where
  getEventId :: a -> EventId

instance HasEventId (EventId, a) where
  getEventId :: (EventId, a) -> EventId
getEventId = (EventId, a) -> EventId
forall a b. (a, b) -> a
fst

newtype EventSource e m = EventSource
  { forall e (m :: * -> *). EventSource e m -> HasEventId e => m [e]
getEvents :: HasEventId e => m [e]
  -- ^ Retrieve all events from the event source.
  }

newtype EventSink e m = EventSink
  { forall e (m :: * -> *). EventSink e m -> HasEventId e => e -> m ()
putEvent :: HasEventId e => e -> m ()
  -- ^ Send a single event to the event sink.
  }

-- | Put a list of events to a list of event sinks in a round-robin fashion.
putEventsToSinks :: (Monad m, HasEventId e) => [EventSink e m] -> [e] -> m ()
putEventsToSinks :: forall (m :: * -> *) e.
(Monad m, HasEventId e) =>
[EventSink e m] -> [e] -> m ()
putEventsToSinks [EventSink e m]
sinks [e]
events =
  [e] -> (e -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [e]
events ((e -> m ()) -> m ()) -> (e -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \e
event ->
    [EventSink e m] -> (EventSink e m -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [EventSink e m]
sinks ((EventSink e m -> m ()) -> m ())
-> (EventSink e m -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \EventSink e m
sink ->
      EventSink e m -> HasEventId e => e -> m ()
forall e (m :: * -> *). EventSink e m -> HasEventId e => e -> m ()
putEvent EventSink e m
sink e
event

-- * State change events as used by Hydra.Node

-- | A state change event with an event id that is the common entity to be
-- loaded from an 'EventSource' and sent to 'EventSink's.
data StateEvent tx = StateEvent
  { forall tx. StateEvent tx -> EventId
eventId :: EventId
  , forall tx. StateEvent tx -> StateChanged tx
stateChanged :: StateChanged tx
  }
  deriving ((forall x. StateEvent tx -> Rep (StateEvent tx) x)
-> (forall x. Rep (StateEvent tx) x -> StateEvent tx)
-> Generic (StateEvent tx)
forall x. Rep (StateEvent tx) x -> StateEvent tx
forall x. StateEvent tx -> Rep (StateEvent tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (StateEvent tx) x -> StateEvent tx
forall tx x. StateEvent tx -> Rep (StateEvent tx) x
$cfrom :: forall tx x. StateEvent tx -> Rep (StateEvent tx) x
from :: forall x. StateEvent tx -> Rep (StateEvent tx) x
$cto :: forall tx x. Rep (StateEvent tx) x -> StateEvent tx
to :: forall x. Rep (StateEvent tx) x -> StateEvent tx
Generic)

instance HasEventId (StateEvent tx) where
  getEventId :: StateEvent tx -> EventId
getEventId = StateEvent tx -> EventId
forall tx. StateEvent tx -> EventId
eventId

deriving instance IsChainState tx => Show (StateEvent tx)
deriving instance IsChainState tx => Eq (StateEvent tx)
deriving instance IsChainState tx => ToJSON (StateEvent tx)
deriving instance IsChainState tx => FromJSON (StateEvent tx)

instance (ArbitraryIsTx tx, IsChainState tx) => Arbitrary (StateEvent tx) where
  arbitrary :: Gen (StateEvent tx)
arbitrary = Gen (StateChanged tx)
forall a. Arbitrary a => Gen a
arbitrary Gen (StateChanged tx)
-> (StateChanged tx -> Gen (StateEvent tx)) -> Gen (StateEvent tx)
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StateChanged tx -> Gen (StateEvent tx)
forall tx. StateChanged tx -> Gen (StateEvent tx)
genStateEvent
  shrink :: StateEvent tx -> [StateEvent tx]
shrink = StateEvent tx -> [StateEvent tx]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance (ArbitraryIsTx tx, IsChainState tx) => ToADTArbitrary (StateEvent tx)

genStateEvent :: StateChanged tx -> Gen (StateEvent tx)
genStateEvent :: forall tx. StateChanged tx -> Gen (StateEvent tx)
genStateEvent StateChanged tx
sc = EventId -> StateChanged tx -> StateEvent tx
forall tx. EventId -> StateChanged tx -> StateEvent tx
StateEvent (EventId -> StateChanged tx -> StateEvent tx)
-> Gen EventId -> Gen (StateChanged tx -> StateEvent tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EventId
forall a. Arbitrary a => Gen a
arbitrary Gen (StateChanged tx -> StateEvent tx)
-> Gen (StateChanged tx) -> Gen (StateEvent tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> StateChanged tx -> Gen (StateChanged tx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StateChanged tx
sc