{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE UndecidableInstances #-}

module Hydra.HeadLogic.StateEvent where

import Hydra.Chain.ChainState (IsChainState)
import Hydra.Events (EventId, HasEventId (..))
import Hydra.HeadLogic (HeadState)
import Hydra.HeadLogic.Outcome (StateChanged (Checkpoint))
import Hydra.Prelude
import Hydra.Tx (ArbitraryIsTx)

-- * 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
  , forall tx. StateEvent tx -> UTCTime
time :: UTCTime
  }
  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

genStateEvent :: StateChanged tx -> Gen (StateEvent tx)
genStateEvent :: forall tx. StateChanged tx -> Gen (StateEvent tx)
genStateEvent StateChanged tx
sc = EventId -> StateChanged tx -> UTCTime -> StateEvent tx
forall tx. EventId -> StateChanged tx -> UTCTime -> StateEvent tx
StateEvent (EventId -> StateChanged tx -> UTCTime -> StateEvent tx)
-> Gen EventId -> Gen (StateChanged tx -> UTCTime -> 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 -> UTCTime -> StateEvent tx)
-> Gen (StateChanged tx) -> Gen (UTCTime -> 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 Gen (UTCTime -> StateEvent tx)
-> Gen UTCTime -> 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
<*> Gen UTCTime
forall a. Arbitrary a => Gen a
arbitrary

mkCheckpoint :: HeadState tx -> EventId -> UTCTime -> StateEvent tx
mkCheckpoint :: forall tx. HeadState tx -> EventId -> UTCTime -> StateEvent tx
mkCheckpoint HeadState tx
headState EventId
eventId UTCTime
time =
  StateEvent
    { EventId
$sel:eventId:StateEvent :: EventId
eventId :: EventId
eventId
    , $sel:stateChanged:StateEvent :: StateChanged tx
stateChanged = HeadState tx -> StateChanged tx
forall tx. HeadState tx -> StateChanged tx
Checkpoint HeadState tx
headState
    , UTCTime
$sel:time:StateEvent :: UTCTime
time :: UTCTime
time
    }