{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Test.Hindsight.Store.PropertyTests (
    propertyTests,
)
where

import Control.Monad.IO.Class (liftIO)
import Data.Map.Strict qualified as Map
import Data.UUID.V4 qualified as UUID
import Hedgehog
import Hindsight.Store
import Test.Hindsight.Store.Common (makeUserEvent)
import Test.Hindsight.Store.TestRunner (EventStoreTestRunner (..))
import Test.Tasty
import Test.Tasty.HUnit (assertFailure)
import Test.Tasty.Hedgehog

-- | Backend-agnostic property-based tests
propertyTests ::
    forall backend.
    (EventStore backend, StoreConstraints backend IO, Show (Cursor backend)) =>
    EventStoreTestRunner backend ->
    TestTree
propertyTests :: forall backend.
(EventStore backend, StoreConstraints backend IO,
 Show (Cursor backend)) =>
EventStoreTestRunner backend -> TestTree
propertyTests EventStoreTestRunner backend
runner =
    TestName -> [TestTree] -> TestTree
testGroup
        TestName
"Property-Based Tests"
        [ TestName -> Property -> TestTree
testProperty TestName
"ExactVersion uniqueness" (EventStoreTestRunner backend -> Property
forall backend.
(EventStore backend, StoreConstraints backend IO,
 Show (Cursor backend)) =>
EventStoreTestRunner backend -> Property
prop_exactVersionUniqueness EventStoreTestRunner backend
runner)
        ]

{- | Property: No two operations with the same ExactVersion should succeed
This is a fundamental consistency property that ALL backends must satisfy.
-}
prop_exactVersionUniqueness ::
    forall backend.
    (EventStore backend, StoreConstraints backend IO, Show (Cursor backend)) =>
    EventStoreTestRunner backend ->
    Property
prop_exactVersionUniqueness :: forall backend.
(EventStore backend, StoreConstraints backend IO,
 Show (Cursor backend)) =>
EventStoreTestRunner backend -> Property
prop_exactVersionUniqueness EventStoreTestRunner backend
runner = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
    TestT IO () -> PropertyT IO ()
forall (m :: * -> *) a. Monad m => TestT m a -> PropertyT m a
test (TestT IO () -> PropertyT IO ()) -> TestT IO () -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> TestT IO ()
forall a. IO a -> TestT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TestT IO ()) -> IO () -> TestT IO ()
forall a b. (a -> b) -> a -> b
$ EventStoreTestRunner backend
-> forall a. (BackendHandle backend -> IO a) -> IO ()
forall backend.
EventStoreTestRunner backend
-> forall a. (BackendHandle backend -> IO a) -> IO ()
withStore EventStoreTestRunner backend
runner ((BackendHandle backend -> IO ()) -> IO ())
-> (BackendHandle backend -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \BackendHandle backend
store -> do
        streamId <- IO StreamId -> IO StreamId
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO StreamId -> IO StreamId) -> IO StreamId -> IO StreamId
forall a b. (a -> b) -> a -> b
$ UUID -> StreamId
StreamId (UUID -> StreamId) -> IO UUID -> IO StreamId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UUID
UUID.nextRandom

        -- First, create the stream and get a cursor
        initResult <-
            insertEvents store Nothing $
                Transaction (Map.singleton streamId (StreamWrite NoStream [makeUserEvent 0]))

        cursor <- case initResult of
            SuccessfulInsertion (InsertionSuccess{finalCursor :: forall backend. InsertionSuccess backend -> Cursor backend
finalCursor = Cursor backend
c}) -> Cursor backend -> IO (Cursor backend)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cursor backend
c
            FailedInsertion EventStoreError backend
err -> TestName -> IO (Cursor backend)
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> IO (Cursor backend))
-> TestName -> IO (Cursor backend)
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to initialize stream: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ EventStoreError backend -> TestName
forall a. Show a => a -> TestName
show EventStoreError backend
err

        -- Now try two operations with the same exact cursor
        let operation1 = StreamId
-> StreamWrite [] SomeLatestEvent backend
-> Map StreamId (StreamWrite [] SomeLatestEvent backend)
forall k a. k -> a -> Map k a
Map.singleton StreamId
streamId (ExpectedVersion backend
-> [SomeLatestEvent] -> StreamWrite [] SomeLatestEvent backend
forall {k} (t :: k -> *) (e :: k) backend.
ExpectedVersion backend -> t e -> StreamWrite t e backend
StreamWrite (Cursor backend -> ExpectedVersion backend
forall backend. Cursor backend -> ExpectedVersion backend
ExactVersion Cursor backend
cursor) [Int -> SomeLatestEvent
makeUserEvent Int
1])
        let operation2 = StreamId
-> StreamWrite [] SomeLatestEvent backend
-> Map StreamId (StreamWrite [] SomeLatestEvent backend)
forall k a. k -> a -> Map k a
Map.singleton StreamId
streamId (ExpectedVersion backend
-> [SomeLatestEvent] -> StreamWrite [] SomeLatestEvent backend
forall {k} (t :: k -> *) (e :: k) backend.
ExpectedVersion backend -> t e -> StreamWrite t e backend
StreamWrite (Cursor backend -> ExpectedVersion backend
forall backend. Cursor backend -> ExpectedVersion backend
ExactVersion Cursor backend
cursor) [Int -> SomeLatestEvent
makeUserEvent Int
2])

        result1 <- insertEvents store Nothing (Transaction operation1)
        result2 <- insertEvents store Nothing (Transaction operation2)

        let successes = [InsertionResult backend] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([InsertionResult backend] -> Int)
-> [InsertionResult backend] -> Int
forall a b. (a -> b) -> a -> b
$ (InsertionResult backend -> Bool)
-> [InsertionResult backend] -> [InsertionResult backend]
forall a. (a -> Bool) -> [a] -> [a]
filter InsertionResult backend -> Bool
forall backend. InsertionResult backend -> Bool
isSuccessfulInsertion [InsertionResult backend
result1, InsertionResult backend
result2]
        if successes == 1
            then pure ()
            else assertFailure $ "Expected exactly 1 success, got " ++ show successes

-- Helper functions
isSuccessfulInsertion :: InsertionResult backend -> Bool
isSuccessfulInsertion :: forall backend. InsertionResult backend -> Bool
isSuccessfulInsertion (SuccessfulInsertion InsertionSuccess backend
_) = Bool
True
isSuccessfulInsertion (FailedInsertion EventStoreError backend
_) = Bool
False