Revision 39c1e700 src/Ganeti/WConfd/Monad.hs

b/src/Ganeti/WConfd/Monad.hs
44 44 
  , daemonHandle
45 45 
  , modifyConfigState
46 46 
  , readConfigState
47 
  , modifyLockAllocation
48 
  , modifyLockAllocation_
47 
  , modifyLockWaiting
48 
  , modifyLockWaiting_
49 49 
  , readLockAllocation
50 50 
  ) where
51 51 

  		





  52
  52
  
    
import Control.Applicative


  		





  53
  
  
    
import Control.Arrow ((&&&))


  		





  
  53
  
    
import Control.Arrow ((&&&), second)


  		





  54
  54
  
    
import Control.Monad


  		





  55
  55
  
    
import Control.Monad.Base


  		





  56
  56
  
    
import Control.Monad.Error


  		





  57
  57
  
    
import Control.Monad.Reader


  		





  58
  58
  
    
import Control.Monad.Trans.Control


  		





  59
  59
  
    
import Data.IORef.Lifted


  		





  
  60
  
    
import qualified Data.Set as S


  		





  60
  61
  
    
import Data.Tuple (swap)


  		





  61
  62
  
    
import qualified Text.JSON as J


  		





  62
  63
  
    

  		





  63
  64
  
    
import Ganeti.BasicTypes


  		





  64
  65
  
    
import Ganeti.Errors


  		





  65
  66
  
    
import Ganeti.Lens


  		





  
  67
  
    
import Ganeti.Locking.Allocation (LockAllocation)


  		





  66
  68
  
    
import Ganeti.Locking.Locks


  		





  
  69
  
    
import Ganeti.Locking.Waiting (getAllocation)


  		





  67
  70
  
    
import Ganeti.Logging


  		





  68
  71
  
    
import Ganeti.Utils.AsyncWorker


  		





  69
  72
  
    
import Ganeti.WConfd.ConfigState


  		





  ......




  74
  77
  
    
-- locking state.


  		





  75
  78
  
    
data DaemonState = DaemonState


  		





  76
  79
  
    
  { dsConfigState :: ConfigState


  		





  77
  
  
    
  , dsLockAllocation :: GanetiLockAllocation


  		





  
  80
  
    
  , dsLockWaiting :: GanetiLockWaiting


  		





  78
  81
  
    
  }


  		





  79
  82
  
    

  		





  80
  83
  
    
$(makeCustomLenses ''DaemonState)


  		





  ......




  93
  96
  
    

  		





  94
  97
  
    
mkDaemonHandle :: FilePath


  		





  95
  98
  
    
               -> ConfigState


  		





  96
  
  
    
               -> GanetiLockAllocation


  		





  
  99
  
    
               -> GanetiLockWaiting


  		





  97
  100
  
    
               -> (IO ConfigState -> ResultG (AsyncWorker ()))


  		





  98
  101
  
    
                  -- ^ A function that creates a worker that asynchronously


  		





  99
  102
  
    
                  -- saves the configuration to the master file.


  		





  ......




  103
  106
  
    
               -> (IO ConfigState -> ResultG (AsyncWorker ()))


  		





  104
  107
  
    
                  -- ^ A function that creates a worker that asynchronously


  		





  105
  108
  
    
                  -- distributes SSConf to nodes


  		





  106
  
  
    
               -> (IO GanetiLockAllocation -> ResultG (AsyncWorker ()))


  		





  
  109
  
    
               -> (IO GanetiLockWaiting -> ResultG (AsyncWorker ()))


  		





  107
  110
  
    
                  -- ^ A function that creates a worker that asynchronously


  		





  108
  111
  
    
                  -- saves the lock allocation state.


  		





  109
  112
  
    
               -> ResultG DaemonHandle


  		





  ......




  117
  120
  
    
  ssconfWorker <- distSSConfWorkerFn readConfigIO


  		





  118
  121
  
    
  distMCsWorker <- distMCsWorkerFn readConfigIO


  		





  119
  122
  
    

  		





  120
  
  
    
  saveLockWorker <- saveLockWorkerFn $ dsLockAllocation `liftM` readIORef ds


  		





  
  123
  
    
  saveLockWorker <- saveLockWorkerFn $ dsLockWaiting `liftM` readIORef ds


  		





  121
  124
  
    

  		





  122
  125
  
    
  return $ DaemonHandle ds cpath saveWorker distMCsWorker ssconfWorker


  		





  123
  126
  
    
                                 saveLockWorker


  		





  ......




  200
  203
  
    
    return ()


  		





  201
  204
  
    
  return r


  		





  202
  205
  
    

  		





  203
  
  
    
-- | Atomically modifies the lock allocation state in WConfdMonad.


  		





  204
  
  
    
modifyLockAllocation :: (GanetiLockAllocation -> (GanetiLockAllocation, a))


  		





  
  206
  
    
-- | Atomically modifies the lock waiting state in WConfdMonad.


  		





  
  207
  
    
modifyLockWaiting :: (GanetiLockWaiting -> ( GanetiLockWaiting


  		





  
  208
  
    
                                           , (a, S.Set ClientId) ))


  		





  205
  209
  
    
                     -> WConfdMonad a


  		





  206
  
  
    
modifyLockAllocation f = do


  		





  
  210
  
    
modifyLockWaiting f = do


  		





  207
  211
  
    
  dh <- lift . WConfdMonadInt $ ask


  		





  208
  212
  
    
  let f' = swap . (fst &&& id) . f


  		





  209
  
  
    
  (lockAlloc, r) <- atomicModifyIORef (dhDaemonState dh)


  		





  210
  
  
    
                                      (swap . traverseOf dsLockAllocationL f')


  		





  
  213
  
    
  (lockAlloc, (r, nfy)) <- atomicModifyIORef


  		





  
  214
  
    
                             (dhDaemonState dh)


  		





  
  215
  
    
                             (swap . traverseOf dsLockWaitingL f')


  		





  211
  216
  
    
  logDebug $ "Current lock status: " ++ J.encode lockAlloc


  		





  212
  217
  
    
  logDebug "Triggering lock state write"


  		





  213
  218
  
    
  liftBase . triggerAndWait . dhSaveLocksWorker $ dh


  		





  214
  219
  
    
  logDebug "Lock write finished"


  		





  
  220
  
    
  unless (S.null nfy) $ do


  		





  
  221
  
    
    logDebug . (++) "Locks became available for " . show $ S.toList nfy


  		





  
  222
  
    
    logWarning "Process notification not yet implemented"


  		





  215
  223
  
    
  return r


  		





  216
  224
  
    

  		





  217
  225
  
    
-- | Atomically modifies the lock allocation state in WConfdMonad, not


  		





  218
  226
  
    
-- producing any result


  		





  219
  
  
    
modifyLockAllocation_ :: (GanetiLockAllocation -> GanetiLockAllocation)


  		





  
  227
  
    
modifyLockWaiting_ :: (GanetiLockWaiting -> (GanetiLockWaiting, S.Set ClientId))


  		





  220
  228
  
    
                      -> WConfdMonad ()


  		





  221
  
  
    
modifyLockAllocation_ = modifyLockAllocation . (flip (,) () .)


  		





  
  229
  
    
modifyLockWaiting_ = modifyLockWaiting . ((second $ (,) ()) .)


  		





  222
  230
  
    

  		





  223
  
  
    
-- | Read the lock allocation state.


  		





  224
  
  
    
readLockAllocation :: WConfdMonad GanetiLockAllocation


  		





  225
  
  
    
readLockAllocation = liftM dsLockAllocation . readIORef . dhDaemonState


  		





  
  231
  
    
-- | Read the underlying lock allocation.


  		





  
  232
  
    
readLockAllocation :: WConfdMonad (LockAllocation GanetiLocks ClientId)


  		





  
  233
  
    
readLockAllocation = liftM (getAllocation . dsLockWaiting)


  		





  
  234
  
    
                     . readIORef . dhDaemonState


  		





  226
  235
  
    
                     =<< daemonHandle


  		












Also available in:
  Unified diff