-------------------------------------------------------------------------------- -- | -- Module : Database.EventStore.Internal.Operation.DeleteStreamOperation -- Copyright : (C) 2014 Yorick Laupa -- License : (see the file LICENSE) -- -- Maintainer : Yorick Laupa -- Stability : provisional -- Portability : non-portable -- -------------------------------------------------------------------------------- module Database.EventStore.Internal.Operation.DeleteStreamOperation ( deleteStreamOperation ) where -------------------------------------------------------------------------------- import Control.Concurrent.STM import Data.Maybe -------------------------------------------------------------------------------- import Data.Text -------------------------------------------------------------------------------- import Database.EventStore.Internal.Operation.Common import Database.EventStore.Internal.Types -------------------------------------------------------------------------------- deleteStreamOperation :: Settings -> TMVar (OperationExceptional DeleteResult) -> Text -> ExpectedVersion -> Maybe Bool -> Operation deleteStreamOperation settings mvar stream_id exp_ver hard_del = createOperation params where params = OperationParams { opSettings = settings , opRequestCmd = DeleteStreamCmd , opResponseCmd = DeleteStreamCompletedCmd , opRequest = let req_master = _requireMaster settings exp_ver_int = expVersionInt32 exp_ver request = newDeleteStream stream_id exp_ver_int req_master hard_del in return request , opSuccess = inspect mvar stream_id exp_ver , opFailure = failed mvar } -------------------------------------------------------------------------------- inspect :: TMVar (OperationExceptional DeleteResult) -> Text -> ExpectedVersion -> DeleteStreamCompleted -> IO Decision inspect mvar stream exp_ver dsc = go (getField $ deleteCompletedResult dsc) where go OP_SUCCESS = succeed mvar dsc go OP_PREPARE_TIMEOUT = return Retry go OP_FORWARD_TIMEOUT = return Retry go OP_COMMIT_TIMEOUT = return Retry go OP_WRONG_EXPECTED_VERSION = failed mvar wrong_version go OP_STREAM_DELETED = failed mvar (StreamDeleted stream) go OP_INVALID_TRANSACTION = failed mvar InvalidTransaction go OP_ACCESS_DENIED = failed mvar (AccessDenied stream) wrong_version = WrongExpectedVersion stream exp_ver -------------------------------------------------------------------------------- succeed :: TMVar (OperationExceptional DeleteResult) -> DeleteStreamCompleted -> IO Decision succeed mvar wec = do atomically $ putTMVar mvar (Right wr) return EndOperation where com_pos = getField $ deleteCompletedCommitPosition wec pre_pos = getField $ deleteCompletedPreparePosition wec com_pos_int = fromMaybe (-1) com_pos pre_pos_int = fromMaybe (-1) pre_pos pos = Position com_pos_int pre_pos_int wr = DeleteResult pos -------------------------------------------------------------------------------- failed :: TMVar (OperationExceptional DeleteResult) -> OperationException -> IO Decision failed mvar e = do atomically $ putTMVar mvar (Left e) return EndOperation