module EZCouch.EntityIsolation where
import Prelude ()
import ClassyPrelude
import qualified Data.Traversable as Traversable
import qualified Data.List as List
import qualified Data.Time as Time
import Data.Aeson
import EZCouch.Time
import EZCouch.Types
import EZCouch.Action
import EZCouch.Entity
import EZCouch.ReadAction
import EZCouch.WriteAction
import EZCouch.Try
import qualified EZCouch.Model.EntityIsolation as Model
import qualified Util.Logging as Logging
logM lvl = Logging.logM lvl "EZCouch.EntityIsolation"
data Isolation e = Isolation {
isolationIdRev :: IdRev Model.EntityIsolation,
isolationIdentified :: Identified e
}
isolationEntity = identifiedValue . isolationIdentified
isolateEntity :: (MonadAction m, Entity e)
=> Int
-> Persisted e
-> m (Maybe (Isolation e))
isolateEntity timeout persisted = do
results <- isolateEntities timeout . singleton $ persisted
case results of
[result] -> return result
_ -> throwIO $ ServerException $ "EZCouch.EntityIsolation.isolateEntity"
isolateEntities :: (MonadAction m, Entity e)
=> Int
-> [Persisted e]
-> m ([Maybe (Isolation e)])
isolateEntities timeout entities = do
till <- Time.addUTCTime (fromIntegral timeout) <$> readTime
results <- createIdentifiedEntities $
map (entityIsolationId &&& entityIsolationModel till) entities
forM (List.zip entities results) $ \r -> case r of
(entity, Right isolation) -> return $ Just $
Isolation (persistedIdRev isolation) (persistedIdentified entity)
_ -> return Nothing
entityIsolationModel :: (Entity e)
=> Time.UTCTime -> Persisted e -> Model.EntityIsolation
entityIsolationModel till entity =
Model.EntityIsolation
(persistedId entity)
(toJSON $ persistedValue entity)
till
entityIsolationId :: Persisted e -> Text
entityIsolationId entity =
entityType (undefined :: Model.EntityIsolation)
++ "-" ++ persistedId entity
releaseIsolation :: (MonadAction m, Entity e)
=> Isolation e
-> m (Persisted e)
releaseIsolation =
releaseIsolations . singleton >=> maybe fail return . listToMaybe
where
fail = throwIO $ ServerException "EZCouch.EntityIsolation.releaseIsolation"
releaseIsolations :: (MonadAction m, Entity e)
=> [Isolation e]
-> m [Persisted e]
releaseIsolations isolations = do
results <- createIdentifiedEntities $ map isolationIdentified isolations
case sequence results of
Left _ -> throwIO $ OperationException $
"Could not recreate entities under following ids when releasing the isolation: " ++ show (map fst . lefts $ results)
Right entities -> do
deleteEntitiesByIdRevs $ map isolationIdRev isolations
return entities
deleteIsolation :: (MonadAction m, Entity e)
=> Isolation e
-> m ()
deleteIsolation = deleteIsolations . singleton
deleteIsolations :: (MonadAction m, Entity e)
=> [Isolation e]
-> m ()
deleteIsolations isolations =
deleteEntitiesByIdRevs $ map isolationIdRev isolations