{-# LANGUAGE CPP #-}moduleHappstack.State.TxControl(runTxSystem,runTxSystemAmazon,shutdownSystem,createCheckpoint)whereimportSystem.Log.LoggerimportControl.MonadimportControl.ExceptionimportControl.ConcurrentimportqualifiedHappstack.State.CheckpointasCheckpointimportHappstack.State.SaverimportHappstack.State.Transaction#ifdef REPLICATIONimportqualifiedHappstack.State.CentralLogServerasLogServer#endifimportHappstack.State.ComponentSystemimportHappstack.Data.ProxylogMM::Priority->String->IO()logMM=logM"Happstack.State.TxControl"-- | Given a Saver and a Proxy, createTxControl will -- initialize a TxControl. This does not actually start the-- state system.createTxControl::(Methodsstate,Componentstate)=>Saver->Proxystate->IO(MVarTxControl)createTxControlsaverprox=do-- The state hasn't been loaded yet. Ignore events.eventSaverVar<-newMVar=<<createWriterNullSaver"events"0-- obtain a prefix locklock<-obtainLocksavernewMVar$TxControl{ctlSaver=saver,ctlEventSaver=eventSaverVar,ctlAllComponents=allStateTypesprox,ctlComponentVersions=componentVersionsprox,ctlChildren=[],ctlPrefixLock=lock,ctlCreateCheckpoint=return()}-- | Saves the state and closes the serializationcloseTxControl::MVarTxControl->IO()closeTxControlctlVar=doctl<-takeMVarctlVarwriterClose=<<takeMVar(ctlEventSaverctl)releaseLock(ctlPrefixLockctl)-- | Run the MACID system without multimaster support and with the given Saver.runTxSystem::(Methodsst,Componentst)=>Saver->Proxyst->IO(MVarTxControl)runTxSystemsaverstateProxy=dologMMNOTICE"Initializing system control."ctl<-createTxControlsaverstateProxy-- insert code to lock based on the saverlogMMNOTICE"Creating event mapper."localEventMap<-createEventMapctlstateProxysetNewEventMaplocalEventMaplogMMNOTICE"Restoring state."enableLogging<-Checkpoint.restoreStatectl-- Multimaster support used to be here. --enableLoggingletioActions=componentIOstateProxylogMMNOTICE"Forking children."children<-forMioActions$\action->domv<-newEmptyMVartid<-forkIO(action`finally`putMVarmv())return(tid,mv)modifyMVar_ctl$\c->returnc{ctlChildren=children,ctlCreateCheckpoint=Checkpoint.createCheckpointctl}returnctl#ifdef REPLICATIONrunTxSystemAmazon::(Methodsst,Componentst)=>LogServer.ApplicationName->Proxyst->IO(MVarTxControl)runTxSystemAmazonappNamestateProxy=dologMMNOTICE"Initializing system control"ctl<-createTxControlNullSaverstateProxylogMMNOTICE"Creating local event mapper."localEventMap<-createEventMapctlstateProxylogMMNOTICE"Connecting to central log server."cluster<-LogServer.connectToClusterappNamelocalEventMaplogMMNOTICE"Modifying local event map."eventMap<-LogServer.changeEventMappinglocalEventMapclustersetNewEventMapeventMapletioActions=componentIOstateProxylogMMNOTICE"Forking children."children<-forMioActions$\action->domv<-newEmptyMVartid<-forkIO(action`finally`putMVarmv())return(tid,mv)modifyMVar_ctl$\c->returnc{ctlChildren=children,ctlCreateCheckpoint=LogServer.createCheckpointctlcluster}returnctl#elsetypeApplicationName=String-- Hm, this should actually be defined in CentralLogServer.hsrunTxSystemAmazon::(Methodsst,Componentst)=>ApplicationName->Proxyst->IO(MVarTxControl)runTxSystemAmazonappNamestateProxy=error"Happstack-state has been built without replication support."#endifcreateCheckpoint::MVarTxControl->IO()createCheckpoint=join.fmapctlCreateCheckpoint.readMVar-- | Shuts down a transaction systemshutdownSystem::MVarTxControl->IO()shutdownSystemctl=dologMMNOTICE"Shutting down."children<-liftMctlChildren$readMVarctllogMMNOTICE"Killing children."mapM_(killThread.fst)childrenmapM_(takeMVar.snd)children-- FIXME: Use a timeout.logMMNOTICE"Shutdown complete"closeTxControlctl