-- | Event store backend. You only need to import this
-- module if you're planning on implementing a custom
-- event store backend.
module Data.CQRS.EventStore.Backend
       ( EventStoreBackend(..)
       , RawEvent
       , RawSnapshot(..)
       ) where

import Data.ByteString (ByteString)
import Data.Conduit (ResourceT, Source)
import Data.CQRS.GUID
import Data.CQRS.PersistedEvent (PersistedEvent)

-- | Raw event type. The data associated with an event is not
-- translated in any way.
type RawEvent = PersistedEvent ByteString

-- | Raw snapshot.
data RawSnapshot =
  RawSnapshot { rsVersion :: Int
              , rsSnapshotData :: ByteString
              }
  deriving (Eq,Ord,Show)

-- | Event stores are the backend used for reading and storing all the
-- information about recorded events.
class EventStoreBackend esb where
    -- | Store a sequence of events for aggregate identified by GUID
    -- into the event store, starting at the provided version number.
    -- If the version number does not match the expected value, a
    -- failure occurs.
    esbStoreEvents :: esb -> GUID -> Int -> [RawEvent] -> IO ()
    -- | Retrieve the sequence of events associated with the aggregate
    -- identified by the given GUID. Only events at or after the given
    -- version number are retrieved. The events are returned in
    -- increasing order of version number.
    esbRetrieveEvents :: esb -> GUID -> Int -> Source (ResourceT IO) RawEvent
    -- | Enumerate all events. There is no guarantee on the ordering
    -- of events /except/ that events for any specific aggregate root
    -- are returned in order of version number.
    esbEnumerateAllEvents :: esb -> Source (ResourceT IO) RawEvent
    -- | Write snapshot for aggregate identified by GUID and
    -- the given version number. The version number is NOT checked
    -- for validity. If the event store does not support snapshots
    -- this function may do nothing.
    esbWriteSnapshot :: esb -> GUID -> RawSnapshot -> IO ()
    -- | Get latest snapshot of an aggregate identified by GUID.
    -- Returns the version number of the snapshot in addition to the
    -- data. An event store which does not support snapshots is
    -- permitted to return 'Nothing' in all cases.
    esbGetLatestSnapshot :: esb -> GUID -> IO (Maybe RawSnapshot)
    -- | Run transaction against the event store. The transaction is
    -- expected to commit if the supplied IO action runs to completion
    -- (i.e. doesn't throw an exception) and to rollback otherwise.
    esbWithTransaction :: forall a . esb -> IO a -> IO a