{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Test.EventSource.Store.Specification (specification) where
import Control.Exception (Exception, throwIO)
import Control.Monad (unless)
import Data.Foldable (for_)
import Control.Concurrent.Async (wait)
import Control.Monad.Base (MonadBase, liftBase)
import Data.Aeson.Types (object, withObject, (.=), (.:))
import Data.Text (Text)
import Data.UUID (toText)
import Data.UUID.V4 (nextRandom)
import EventSource
import Streaming (Stream, Of)
import qualified Streaming.Prelude as Streaming
import Test.Tasty.Hspec
newtype TestEvent = TestEvent Int deriving (Eq, Show)
instance EncodeEvent TestEvent where
encodeEvent (TestEvent v) = do
setEventType "test-event"
setEventPayload $ dataFromJson $ object [ "value" .= v ]
instance DecodeEvent TestEvent where
decodeEvent Event{..} = do
unless (eventType == "test-event") $
Left "Wrong event type"
dataAsParse eventPayload $ withObject "" $ \o ->
fmap TestEvent (o .: "value")
newtype Test = Test Int deriving (Eq, Show)
data TestError = TestError deriving (Eq, Show)
instance Exception TestError
freshStreamName :: MonadBase IO m => m StreamName
freshStreamName = liftBase $ fmap (StreamName . toText) nextRandom
defaultBatch :: Batch
defaultBatch =
Batch'
{ batchFrom = 0
, batchSize = 1
}
decodeAs :: (Traversable t, DecodeEvent a) => t SavedEvent -> Either Text (t a)
decodeAs = traverse (decodeEvent . savedEvent)
streamDecodeAs :: DecodeEvent a
=> Stream (Of SavedEvent) IO ()
-> Stream (Of a) IO ()
streamDecodeAs = Streaming.mapM go
where
go e =
case decodeEvent (savedEvent e) of
Left _ -> throwIO TestError
Right a -> pure a
specification :: Store store => store -> Spec
specification store = do
specify "API - Add event" $ do
let expected = TestEvent 1
name <- freshStreamName
_ <- wait =<< appendEvent store name AnyVersion expected
let stream = unhandled $ readStream store name defaultBatch
evts <- Streaming.toList_ stream
for_ (zip [0..] evts) $ \(num, e) ->
eventNumber e `shouldBe` num
decodeAs evts `shouldBe` Right [expected]
specify "API - Read events in batch" $ do
let expected = fmap TestEvent [1..3]
name <- freshStreamName
_ <- wait =<< appendEvents store name AnyVersion
expected
let stream = unhandled $ readStream store name defaultBatch
got <- Streaming.toList_ stream
decodeAs got `shouldBe` Right expected
specify "API - Subscription working" $ do
let expected = TestEvent 1
name <- freshStreamName
sub <- subscribe store name
_ <- wait =<< appendEvent store name AnyVersion expected
let stream = Streaming.take 1
$ streamDecodeAs
$ subscriptionStream sub
[got] <- Streaming.toList_ stream
got `shouldBe` expected