mealstrom-0.0.1.0: test/Recovery.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}

{-|
Module      : Recovery
Description : Test that recovery works
Copyright   : (c) Max Amanshauser, 2016
License     : MIT
Maintainer  : max@lambdalifting.org
-}
module Recovery(runRecoveryTests) where

import Test.Tasty
import Test.Tasty.HUnit

import Control.Concurrent
import Data.Typeable
import Data.Aeson
import GHC.Generics
import Data.Text
import Data.IORef
import Data.UUID
import Data.UUID.V4

import Mealstrom
import Mealstrom.PostgresJSONStore as PGJSON
import Mealstrom.MemoryStore       as MemStore

type RecoveryKey    = UUID
data RecoveryState  = RecoveryState1  | RecoveryState2  deriving (Eq,Show,Generic,Typeable,ToJSON,FromJSON)
data RecoveryEvent  = RecoveryEvent1  | RecoveryEvent2  deriving (Eq,Show,Generic,Typeable,ToJSON,FromJSON)
data RecoveryAction = RecoveryAction1 | RecoveryAction2 deriving (Eq,Show,Generic,Typeable,ToJSON,FromJSON)

instance MealyInstance RecoveryKey RecoveryState RecoveryEvent RecoveryAction

recoveryTransition :: (RecoveryState,RecoveryEvent) -> (RecoveryState,[RecoveryAction])
recoveryTransition (RecoveryState1,RecoveryEvent1) =
    (RecoveryState2,[RecoveryAction1])

recoveryEffects :: IORef Bool -> MVar () -> Msg RecoveryAction -> IO Bool
recoveryEffects b sync _a = do
    bb <- readIORef b

    -- indicate that we read the IORef and are running the action now
    putMVar sync ()

    return bb

runRecoveryTests :: String -> TestTree
runRecoveryTests c = testGroup "Recovery" [
    testCase "RecoveryPG" (runTest $ PGJSON.mkStore c),
    testCase "RecoveryMem" (runTest (MemStore.mkStore :: Text -> IO (MemoryStore RecoveryKey RecoveryState RecoveryEvent RecoveryAction)))
    ]

runTest c = do
    st     <- c "RecoveryTest"

    b      <- newIORef False
    sync   <- newEmptyMVar

    let t   = FSMTable recoveryTransition (recoveryEffects b sync)
    let fsm = FSMHandle st st t 1 3    -- we have a timeout of 1 second for actions

    i <- nextRandom

    post fsm i RecoveryState1
    mkMsgs [RecoveryEvent1] >>= patch fsm i

    -- action is run for the first time
    takeMVar sync

    -- wait two seconds, so that the action is definitely recoverable
    threadDelay (2 * 10^6)
    writeIORef b True
    recoverAll fsm

    -- action is run again
    takeMVar sync

    -- If we reach this, then the recovery definitely ran, yet the entry in the DB
    -- might still be wrong. That's ok.
    assertBool "Failed action recovers successfully" True