{-# LANGUAGE OverloadedStrings #-} -------------------------------------------------------------------------------- -- | -- Module : Database.EventStore.Internal.Operation.ReadAllEventsOperation -- Copyright : (C) 2014 Yorick Laupa -- License : (see the file LICENSE) -- -- Maintainer : Yorick Laupa -- Stability : provisional -- Portability : non-portable -- -------------------------------------------------------------------------------- module Database.EventStore.Internal.Operation.ReadAllEventsOperation ( readAllEventsOperation ) where -------------------------------------------------------------------------------- import Control.Concurrent.STM import Data.Int import Data.Maybe -------------------------------------------------------------------------------- import Database.EventStore.Internal.Operation.Common import Database.EventStore.Internal.Types -------------------------------------------------------------------------------- readAllEventsOperation :: Settings -> ReadDirection -> TMVar (OperationExceptional AllEventsSlice) -> Int64 -> Int64 -> Int32 -> Bool -> Operation readAllEventsOperation settings dir mvar c_pos p_pos max_c res_link_tos = createOperation params where req = case dir of Forward -> ReadAllEventsForwardCmd Backward -> ReadAllEventsBackwardCmd resp = case dir of Forward -> ReadAllEventsForwardCompletedCmd Backward -> ReadAllEventsBackwardCompletedCmd params = OperationParams { opSettings = settings , opRequestCmd = req , opResponseCmd = resp , opRequest = let req_master = _requireMaster settings request = newReadAllEvents c_pos p_pos max_c res_link_tos req_master in return request , opSuccess = inspect mvar dir , opFailure = failed mvar } -------------------------------------------------------------------------------- inspect :: TMVar (OperationExceptional AllEventsSlice) -> ReadDirection -> ReadAllEventsCompleted -> IO Decision inspect mvar dir raec = go res where res = fromMaybe RA_SUCCESS (getField $ readAECResult raec) may_err = getField $ readAECError raec go RA_ERROR = failed mvar (ServerError may_err) go RA_ACCESS_DENIED = failed mvar (AccessDenied "$all") go _ = succeed mvar dir raec -------------------------------------------------------------------------------- succeed :: TMVar (OperationExceptional AllEventsSlice) -> ReadDirection -> ReadAllEventsCompleted -> IO Decision succeed mvar dir raec = do atomically $ putTMVar mvar (Right ses) return EndOperation where ses = newAllEventsSlice dir raec -------------------------------------------------------------------------------- failed :: TMVar (OperationExceptional AllEventsSlice) -> OperationException -> IO Decision failed mvar e = do atomically $ putTMVar mvar (Left e) return EndOperation