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 EZCouch.Logging
import qualified EZCouch.Model.EntityIsolation as Model
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 $ ResponseException $ "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
results <- return
$ List.zipWith (\e r -> (,) <$> pure e <*> r) entities results
deleteEntities $ map fst $ rights results
forM results $ \r -> case r of
Right (entity, isolation) -> do
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 $ ResponseException "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 = deleteEntitiesByIdRevs . map isolationIdRev